Paso 5 (0)- Trayectorias de hospitalización y mortalidad con foco en condiciones vinculadas a trastornos de salud mental y consumo de sustancias posterior a un primer ingreso por alguno de estos trastornos, en usuarios/as jóvenes y adultos emergentes de población general y pertenecientes a pueblos originarios, 2018-2021, Chile

Preparar la base de datos para representar trayectorias de hospitalización. Mostrar las pruebas de permutaciones (R=1000) para la estabilidad de las soluciones de conglomerados en términos de los índices de calidad.

Autor/a

Andrés González Santa Cruz

Fecha de publicación

1 de abr, 2025

Configurar

Código
# remover objetos y memoria utilizada
rm(list=ls());gc()
          used (Mb) gc trigger (Mb) max used (Mb)
Ncells  598819 32.0    1294971 69.2   686845 36.7
Vcells 1145005  8.8    8388608 64.0  1879001 14.4
Código
#remover imágenes
while(!dev.cur())dev.off()
cat("\014")
Código
if(Sys.info()["sysname"]=="Windows"){
 folder_path <- ifelse(dir.exists("H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/"),
                       "H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II/",
                       "C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2022 (github)/_proposal_grant/2023/")
} else {folder_path <- ""}
load(paste0(folder_path,"20240903_25.RData"))

Paquetes estadísticos

Código
#elegir repositorio
if(Sys.info()["sysname"]=="Windows"){
  options(repos = c(CRAN = "https://cran.dcc.uchile.cl/"))
}
options(install.packages.check.source = "yes") # Chequea la fuente de los paquetes

#borrar caché
#system("fc-cache -f -v")

if(!require(pacman)){install.packages("pacman");require(pacman)}

pacman::p_unlock(lib.loc = .libPaths()) #para no tener problemas reinstalando paquetes

if(Sys.info()["sysname"]=="Windows"){
if (getRversion() != "4.4.1") { stop("Requiere versión de R 4.4.1. Actual: ", getRversion()) }
}

cat("quarto version: "); system("quarto --version") 
quarto version: 
[1] 0
Código
if(!require(job)){install.packages("job");require(job)}
if(!require(kableExtra)){install.packages("kableExtra");require(kableExtra)}
if(!require(tidyverse)){install.packages("tidyverse");require(tidyverse)}
if(!require(cluster)){install.packages("cluster"); require(cluster)}
if(!require(WeightedCluster)){install.packages("WeightedCluster"); require(WeightedCluster)}
if(!require(devtools)){install.packages("devtools"); require(devtools)}
if(!require(TraMineR)){install.packages("TraMineR"); require(TraMineR)}
if(!require(TraMineRextras)){install.packages("TraMineRextras"); require(TraMineRextras)}
if(!require(NbClust)){install.packages("NbClust"); require(NbClust)}
if(!require(haven)){install.packages("haven"); require(haven)}
if(!require(ggseqplot)){install.packages("ggseqplot"); require(ggseqplot)}
if(!require(grid)){install.packages("grid"); require(grid)}
if(!require(gridExtra)){install.packages("gridExtra"); require(gridExtra)}
if(!require(Tmisc)){install.packages("Tmisc"); require(Tmisc)}
if(!require(factoextra)){install.packages("factoextra"); require(factoextra)}
if(!require(stargazer)){install.packages("stargazer"); require(stargazer)}
if(!require(gtsummary)){install.packages("gtsummary"); require(gtsummary)}
if(!require(lmtest)){install.packages("lmtest"); require(lmtest)}
if(!require(emmeans)){install.packages("emmeans"); require(emmeans)}
if(!require(fpp2)){install.packages("fpp2"); require(fpp2)}
if(!require(purrr)){install.packages("purrr"); require(purrr)}
if(!require(forecast)){install.packages("forecast"); require(forecast)}
if(!require(magrittr)){install.packages("magrittr"); require(magrittr)}
if(!require(foreach)){install.packages("foreach"); require(foreach)}
if(!require(doParallel)){install.packages("doParallel"); require(doParallel)}
if(!require(progressr)){install.packages("progressr"); require(progressr)}
if(!require(chisq.posthoc.test)){devtools::install_github("ebbertd/chisq.posthoc.test")}
if(!require(rstatix)){install.packages("rstatix"); require(rstatix)}
if(!require(rio)){install.packages("rio"); require(rio)}
if(!require(cowplot)){install.packages("cowplot"); require(cowplot)}
if(!require(DiagrammeR)){install.packages("DiagrammeR"); require(DiagrammeR)}
if(!require(DiagrammeRsvg)){install.packages("DiagrammeRsvg"); require(DiagrammeRsvg)}
if(!require(rsvg)){install.packages("rsvg"); require(rsvg)}
if(!require(survminer)){install.packages("survminer"); require(survminer)}
Código
seq_mean_t_dos_grupos <- function(bd = NULL, group1, group2) {
  # Agrupar por ambas variables
  resultados <- by(bd, list(group1, group2), seqmeant)
  
  # Obtener todas las combinaciones posibles de los grupos
  combinaciones <- expand.grid(group1 = unique(group1), group2 = unique(group2), stringsAsFactors = FALSE)
  
  # Extraer los resultados y asociarlos con las combinaciones
  resultados_df <- do.call(rbind, lapply(seq_along(resultados), function(i) {
    group_name1 <- attr(resultados, "dimnames")[[1]][i]
    group_name2 <- attr(resultados, "dimnames")[[2]][i]
    
    data.frame(factor_inclusivo_1 = group_name1, 
               factor_inclusivo_2 = group_name2, 
               Mean = resultados[[i]])
  }))
  
  # Unir los resultados con las combinaciones para rellenar los valores faltantes
  final_df <- merge(combinaciones, resultados_df, by.x = c("group1", "group2"), 
                    by.y = c("factor_inclusivo_1", "factor_inclusivo_2"), all.x = TRUE)
  
  return(final_df)
}

multinom_pivot_wider <- function(x) {
  # check inputs match expectatations
  # create tibble of results
  df <- tibble::tibble(outcome_level = unique(x$table_body$groupname_col))
  df$tbl <- 
    purrr::map(
      df$outcome_level,
      function(lvl) {
        gtsummary::modify_table_body(
          x, 
          ~dplyr::filter(.x, .data$groupname_col %in% lvl) |>
            dplyr::ungroup() |>
            dplyr::select(-.data$groupname_col)
        )
      }
    )
  
  tbl_merge(df$tbl, tab_spanner = paste0("**", df$outcome_level, "**"))
}

best_subset_multinom <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  
  # Generar todas las combinaciones posibles de predictores
  predictors_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) |> unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar los resultados
  results <- list()
  
  # Iterar sobre cada combinación de predictores
  for (i in seq_along(predictors_list)) {
    predictors <- predictors_list[[i]]
    formula <- as.formula(paste(y, "~", paste(predictors, collapse = "+")))
    
    # Ajustar el modelo multinomial
    model <- tryCatch(
      nnet::multinom(formula, data = data, trace = FALSE),
      error = function(e) NULL
    )
    
    # Si el modelo se ajustó correctamente, almacenar los resultados
    if (!is.null(model)) {
      # Extraer el AIC del modelo
      aic <- AIC(model)
      
      # Almacenar la información en una lista
      results[[length(results) + 1]] <- list(
        predictors = predictors,
        model = model,
        AIC = aic
      )
    }
  }
  
  # Convertir la lista de resultados en un dataframe
  results_df <- results |>
    purrr::map_df(function(res) {
      data.frame(
        predictors = paste(res$predictors, collapse = "+"),
        AIC = res$AIC,
        stringsAsFactors = FALSE
      )
    })
  
  # Ordenar los modelos por AIC de menor a mayor
  results_df <- results_df |> arrange(AIC)
  
  return(results_df)
}
best_subset_multinom_interactions <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  
  # Generar todas las combinaciones posibles de predictores (efectos principales)
  main_effects_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) |> unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar los resultados
  results <- list()
  
  # Iterar sobre cada combinación de efectos principales
  for (main_effects in main_effects_list) {
    
    # Generar términos de interacción de hasta 3 variables
    interaction_terms <- list()
    
    # Para interacciones de 2 variables
    if (length(main_effects) >= 2) {
      interaction_terms_2way <- combn(main_effects, 2, function(x) paste(x, collapse = ":"))
      interaction_terms <- c(interaction_terms, interaction_terms_2way)
    }
    
    # Para interacciones de 3 variables
    if (length(main_effects) >= 3) {
      interaction_terms_3way <- combn(main_effects, 3, function(x) paste(x, collapse = ":"))
      interaction_terms <- c(interaction_terms, interaction_terms_3way)
    }
    
    # Combinar efectos principales e interacciones
    all_terms <- c(main_effects, interaction_terms)
    
    # Generar todas las combinaciones posibles de términos (incluyendo interacciones)
    # Solo se incluyen interacciones si sus efectos principales están presentes
    term_combinations <- list()
    
    # Obtener todos los subconjuntos de efectos principales
    main_effects_subsets <- lapply(1:length(main_effects), function(i) {
      combn(main_effects, i, simplify = FALSE)
    }) |> unlist(recursive = FALSE)
    
    # Para cada subconjunto de efectos principales
    for (me in main_effects_subsets) {
      # Iniciar con los efectos principales
      terms <- me
      
      # Incluir interacciones solo si todos sus efectos principales están incluidos
      possible_interactions <- interaction_terms[
        sapply(interaction_terms, function(x) {
          vars_in_interaction <- unlist(strsplit(x, ":"))
          all(vars_in_interaction %in% me)
        })
      ]
      
      # Generar todas las combinaciones de interacciones para incluir
      interaction_subsets <- list(NULL)
      if (length(possible_interactions) > 0) {
        interaction_subsets <- lapply(1:length(possible_interactions), function(i) {
          combn(possible_interactions, i, simplify = FALSE)
        }) |> unlist(recursive = FALSE)
      }
      
      # Para cada combinación de interacciones, crear el conjunto completo de términos
      for (ints in interaction_subsets) {
        if (is.null(ints)) {
          full_terms <- terms
        } else {
          full_terms <- c(terms, ints)
        }
        
        # Añadir a la lista de combinaciones de términos
        term_combinations <- append(term_combinations, list(full_terms))
      }
    }
    
    # Ajustar modelos para cada combinación de términos
    for (terms in term_combinations) {
      formula <- as.formula(paste(y, "~", paste(terms, collapse = "+")))
      
      # Ajustar el modelo multinomial
      model <- tryCatch(
        nnet::multinom(formula, data = data, trace = FALSE),
        error = function(e) NULL,
        warning = function(w) NULL
      )
      
      # Si el modelo se ajustó correctamente, almacenar los resultados
      if (!is.null(model)) {
        # Extraer el BIC del modelo
        bic <- BIC(model)
        
        # Almacenar la información en la lista de resultados
        results[[length(results) + 1]] <- list(
          predictors = paste(terms, collapse = " + "),
          model = model,
          BIC = bic
        )
      }
    }
  }
  
  # Convertir la lista de resultados en un dataframe
  results_df <- results |>
    purrr::map_df(function(res) {
      data.frame(
        predictors = res$predictors,
        BIC = res$BIC,
        stringsAsFactors = FALSE
      )
    })
  
  # Ordenar los modelos por BIC de menor a mayor
  results_df <- results_df |> arrange(BIC)
  
  return(results_df)
}

best_subset_multinom_interactions_parallel <- function(y, x.vars, data) {
  # y       Nombre de la variable dependiente (cadena de texto)
  # x.vars  Vector de nombres de predictores (caracter)
  # data    Dataframe con los datos de entrenamiento
  
  # Cargar las librerías necesarias dentro de la función
  require(dplyr)
  require(purrr)
  require(tidyr)
  require(nnet)
  require(MASS)
  require(foreach)
  require(doParallel)
  require(progressr)
  
  # Iniciar los gestores de progreso
  handlers(global = TRUE)
  handlers("txt")
  
  # Generar todas las combinaciones posibles de predictores (efectos principales)
  main_effects_list <- lapply(1:length(x.vars), function(i) {
    combn(x.vars, i, simplify = FALSE)
  }) |> unlist(recursive = FALSE)
  
  # Inicializar una lista para almacenar las fórmulas de los modelos
  formulas_list <- list()
  
  # Generar todas las fórmulas posibles con interacciones hasta de 3 variables
  for (main_effects in main_effects_list) {
    
    # Generar términos de interacción de hasta 3 variables
    interaction_terms <- character(0)  # Aseguramos que es un vector de caracteres
    
    # Para interacciones de 2 variables
    if (length(main_effects) >= 2) {
      interaction_terms_2way <- combn(main_effects, 2, function(x) paste(x, collapse = ":"), simplify = TRUE)
      interaction_terms <- c(interaction_terms, interaction_terms_2way)
    }
    
    # Para interacciones de 3 variables
    if (length(main_effects) >= 3) {
      interaction_terms_3way <- combn(main_effects, 3, function(x) paste(x, collapse = ":"), simplify = TRUE)
      interaction_terms <- c(interaction_terms, interaction_terms_3way)
    }
    
    # Generar todas las combinaciones posibles de efectos principales
    main_effects_subsets <- lapply(1:length(main_effects), function(i) {
      combn(main_effects, i, simplify = FALSE)
    }) |> unlist(recursive = FALSE)
    
    # Para cada subconjunto de efectos principales
    for (me in main_effects_subsets) {
      # Iniciar con los efectos principales
      terms <- me
      
      # Identificar interacciones cuyos efectos principales están en 'me'
      if (length(interaction_terms) > 0) {
        possible_interactions <- interaction_terms[
          vapply(interaction_terms, function(x) {
            vars_in_interaction <- unlist(strsplit(x, ":"))
            all(vars_in_interaction %in% me)
          }, FUN.VALUE = logical(1))
        ]
      } else {
        possible_interactions <- character(0)
      }
      
      # Generar todas las combinaciones posibles de estas interacciones
      interaction_subsets <- list(character(0))  # Incluir el caso sin interacciones
      if (length(possible_interactions) > 0) {
        interaction_combinations <- lapply(1:length(possible_interactions), function(i) {
          combn(possible_interactions, i, simplify = FALSE)
        }) |> unlist(recursive = FALSE)
        interaction_subsets <- c(interaction_subsets, interaction_combinations)
      }
      
      # Para cada combinación de interacciones
      for (ints in interaction_subsets) {
        full_terms <- c(terms, ints)
        
        # Crear la fórmula del modelo y almacenarla
        formula_str <- paste(y, "~", paste(full_terms, collapse = "+"))
        formulas_list <- append(formulas_list, list(formula_str))
      }
    }
  }
  
  # Eliminar posibles duplicados de fórmulas
  formulas_list <- unique(formulas_list)
  
  # Total de modelos a ajustar
  total_models <- length(formulas_list)
  
  # Iniciar el progreso
  p <- progressor(steps = total_models)
  
  # Ajustar los modelos en paralelo usando foreach
  results_list <- foreach(i = 1:total_models, .packages = c("nnet", "MASS"), .combine = 'rbind') %dopar% {
    formula_str <- formulas_list[[i]]
    formula <- as.formula(formula_str)
    
    # Ajustar el modelo
    model <- tryCatch(
      nnet::multinom(formula, data = data, trace = FALSE),
      error = function(e) NULL,
      warning = function(w) NULL
    )
    
    # Actualizar el progreso
    p(sprintf("Ajustando modelo %d de %d", i, total_models))
    
    # Si el modelo se ajustó correctamente, almacenar los resultados
    if (!is.null(model)) {
      bic <- BIC(model)
      data.frame(
        predictors = formula_str,
        BIC = bic,
        stringsAsFactors = FALSE
      )
    } else {
      NULL
    }
  }
  
  # Convertir los resultados a dataframe y ordenar por BIC
  results_df <- as.data.frame(results_list)
  results_df <- results_df |> arrange(BIC)
  
  return(results_df)
}


num_cores <- parallel::detectCores() - 1
cl <- makeCluster(num_cores)
registerDoParallel(cl)

#pacman job kableExtra tidyverse cluster WeightedCluster devtools TraMineR TraMineRextras NbClust haven ggseqplot gridExtra Tmisc factoextra reticulate withr rmarkdown quarto

options(knitr.kable.NA = '')


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#

knitr::knit_hooks$set(time_it = local({
  now <- NULL
  function(before, options) {
    if (before) {
      # record the current time before each chunk
      now <<- Sys.time()
    } else {
      # calculate the time difference after a chunk
      res <- ifelse(difftime(Sys.time(), now)>(60^2),difftime(Sys.time(), now)/(60^2),difftime(Sys.time(), now)/(60^1))
      # return a character string to show the time
      x<-ifelse(difftime(Sys.time(), now)>(60^2),paste("Tiempo que demora esta sección:", round(res,1), "horas"),paste("Tiempo que demora esta sección:", round(res,1), "minutos"))
      paste('<div class="message">', gsub('##', '\n', x),'</div>', sep = '\n')
    }
  }
}))
knitr::opts_chunk$set(time_it = TRUE)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

format_cells <- function(df, rows ,cols, value = c("italics", "bold", "strikethrough")){
  
  # select the correct markup
  # one * for italics, two ** for bold
  map <- setNames(c("*", "**", "~~"), c("italics", "bold", "strikethrough"))
  markup <- map[value]  
  
  for (r in rows){
    for(c in cols){
      
      # Make sure values are not factors
      df[[c]] <- as.character( df[[c]])
      
      # Update formatting
      df[r, c] <- ifelse(nchar(df[r, c])==0,"",paste0(markup, gsub(" ", "", df[r, c]), markup))
    }
  }
  
  return(df)
}
#To produce line breaks in messages and warnings
knitr::knit_hooks$set(
   error = function(x, options) {
     paste('\n\n<div class="alert alert-danger" style="font-size: small !important;">',
           gsub('##', '\n', gsub('^##\ Error', '**Error**', x)),
           '</div>', sep = '\n')
   },
   warning = function(x, options) {
     paste('\n\n<div class="alert alert-warning" style="font-size: small !important;">',
           gsub('##', '\n', gsub('^##\ Warning:', '**Warning**', x)),
           '</div>', sep = '\n')
   },
   message = function(x, options) {
     paste('<div class="message" style="font-size: small !important;">',
           gsub('##', '\n', x),
           '</div>', sep = '\n')
   }
)

#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Function to format CreateTableOne into a database")

as.data.frame.TableOne <- function(x, ...) {capture.output(print(x,showAllLevels = TRUE, varLabels = T,...) -> x)
  y <- as.data.frame(x)
  y$characteristic <- dplyr::na_if(rownames(x), "")
  y <- y |>
    fill(characteristic, .direction = "down") |>
    dplyr::select(characteristic, everything())
  rownames(y) <- NULL
  y}
#_#_#_#_#_#_#_#_#_#_#_#_#_
# Austin, P. C. (2009). The Relative Ability of Different Propensity 
# Score Methods to Balance Measured Covariates Between 
# Treated and Untreated Subjects in Observational Studies. Medical 
# Decision Making. https://doi.org/10.1177/0272989X09341755
smd_bin <- function(x,y){
  z <- x*(1-x)
  t <- y*(1-y)
  k <- sum(z,t)
  l <- k/2
  
  return((x-y)/sqrt(l))
  
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

format_table_vec <- function(tbl, digits = 1) {
  counts <- as.numeric(tbl)
  percentages <- prop.table(tbl) * 100
  
  formatted <- sapply(seq_along(counts), function(i) {
    p_val <- percentages[i]
    # Si el porcentaje es prácticamente entero, formatea sin decimales
    if (abs(p_val - round(p_val)) < .Machine$double.eps^0.5) {
      p_str <- sprintf("%.0f", p_val)
    } else {
      p_str <- sprintf(paste0("%.", digits, "f"), p_val)
    }
    paste0(counts[i], " (", p_str, ")")
  })
  
  formatted
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:


if(.Platform$OS.type == "windows") withAutoprint({
  memory.size()
  memory.size(TRUE)
  memory.limit()
})
> memory.size()
[1] Inf
> memory.size(TRUE)
[1] Inf
> memory.limit()
[1] Inf
Código
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
func_tab_range_clus<-
function(range_clus){
rbind.data.frame(
  lapply(
    list(
      as.vector(rev(sort(table(range_clus$clustering$cluster2)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster3)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster4)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster5)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster6)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster7)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster8)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster9)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster10)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster11)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster12)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster13)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster14)))),
      as.vector(rev(sort(table(range_clus$clustering$cluster15))))
    ),
    function(x) {
      length_out <- max(sapply(list(
        as.vector(rev(sort(table(range_clus$clustering$cluster2)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster3)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster4)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster5)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster6)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster7)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster8)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster9)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster10)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster11)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster12)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster13)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster14)))),
        as.vector(rev(sort(table(range_clus$clustering$cluster15))))
      ), length))
      c(x, rep(NA, length_out - length(x)))
    }
  )
)|>
  t() |> 
  data.frame()|>
  `rownames<-`(NULL)
}


frobenius_norm <- function(matrix1, matrix2) {
    if (!all(dim(matrix1) == dim(matrix2))) {
        stop("Matrices must have the same dimensions")
    }
    
    # Replace NA values with 0 (or any other desired default)
    matrix1[is.na(matrix1)] <- 0
    matrix2[is.na(matrix2)] <- 0
    
    # Calculate the residuals
    residuals <- matrix1 - matrix2
    
    # Frobenius norm
    frobenius <- sqrt(sum(residuals^2))
    return(frobenius)
}



#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

print.seqnullcqi.powder <- function(x, norm = FALSE, quant = 0.95, digits = 2, 
                                    append = FALSE, ...) {
        confcqi2 <- function(nullstat, quant, n){
          alpha <- (1-quant)/2
          #calpha <- alpha+(alpha-1)/n
          #print(c(calpha, alpha))
          #minmax <- quantile(nullstat, c(calpha, 1-calpha))
          minmax <- quantile(nullstat, c(alpha, 1-alpha))
          return(minmax)
        }
        
        normstatcqi2 <- function(bcq, stat, norm=TRUE){
          origstat <- bcq$clustrange$stats[, stat]
          nullstat <- bcq$stats[[stat]]
          #normstat <- rbind(nullstat, origstat)
          if(norm){
            for(i in seq_along(origstat)){
              mx <- mean(nullstat[, i])
              sdx <- sd(nullstat[, i])
              nullstat[ , i] <- (nullstat[, i]-mx)/sdx
              origstat[i] <- (origstat[i]-mx)/sdx
            }
          }
          alldatamax <- apply(nullstat, 1, max)#as.vector(xx)
          sumcqi <- list(origstat=origstat, nullstat=nullstat, alldatamax=alldatamax)
          return(sumcqi)
        }
    cat("Parametric bootstrap cluster analysis validation\n")
    cat("Sequence analysis null model:", deparse(x$nullmodel), "\n")
    cat("Number of bootstraps:", x$R, "\n")
    cat("Clustering method:", ifelse(x$kmedoid, "PAM/K-Medoid", paste0("hclust with ", x$hclust.method)), "\n")
    cat("Seqdist arguments:", deparse(x$seqdist.args), "\n\n\n")
    alls <- as.data.frame(x$clustrange$stats)
    quants <- rep("", ncol(alls))
    names(quants) <- colnames(alls)
    for (ss in colnames(alls)) {
        sumcqi <- normstatcqi2(x, stat = ss, norm = norm)
        alls[, ss] <- as.character(round(sumcqi$origstat, digits = digits))
        borne <- as.character(round(confcqi2(sumcqi$alldatamax, quant, x$R), digits = digits))
        quants[ss] <- paste0("[", borne[1], "; ", borne[2], "]")
    }
    results_tibble <- tibble::as_tibble(rbind(alls, rep("", length(quants)), quants))
    # Print a summary to the console for immediate feedback
    rownames(results_tibble) <- c(rownames(x$clustrange$stats), "", paste("Null Max-T", quant, "interval"))
    
    results_df <- as.data.frame(results_tibble)
    print(results_tibble, ...)
    return(list(
      results_tibble= results_tibble, 
      results_df= results_df
      ))
}

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
##:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
# Función para aplicar la prueba de Fisher a todas las combinaciones de filas usando todas las columnas
fisher_posthoc_all_cols <- function(contingency_table) {
  # Obtener combinaciones de filas (pares)
  row_pairs <- combn(rownames(contingency_table), 2, simplify = FALSE)
  
  # Aplicar la prueba de Fisher a cada par de filas usando todas las columnas al mismo tiempo
  results <- map_dfr(row_pairs, function(pair) {
    # Crear tabla de 2xN para el par de filas en todas las columnas
    sub_table <- contingency_table[pair, , drop = FALSE]
    
    # Aplicar el test de Fisher
    test_result <- fisher.test(sub_table, 
                                 simulate.p.value=T,
                                 B=1e4)
    
    # Devolver los resultados en un data frame
    tibble(
      Row1 = pair[1],
      Row2 = pair[2],
      p.value = test_result$p.value
    )
  })
  
  # Ajustar p-valores usando el método de Holm
  results <- results |>
    mutate(p.adjusted = p.adjust(p.value, method = "holm"))
  
  return(results)
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
save_base_plot_as_grob <- function(plot_expr, res=300,  width = 1600, height= 1200) {
    # Crea un archivo temporal con extensión .png
    filename <- tempfile(fileext = ".png")
    
    # Guarda el gráfico en alta resolución en el archivo temporal
    png(filename, width = width, height = height, res = res)
    replayPlot(plot_expr)  # Reproduce el gráfico grabado
    dev.off()  # Cierra el dispositivo gráfico
    
    # Convierte el archivo PNG en un objeto gráfico (grob)
    grob <- grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
    
    return(grob)  # Devuelve el grob
}
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
chisq_cramerv<- function(contingency_table){
  chisq_test <- chisq.test(contingency_table)
  cramers_v <- sqrt(chisq_test$statistic / (sum(contingency_table) * (min(dim(contingency_table)) - 1)))
  
  list(chisq_statistic= sprintf("%1.2f", chisq_test$statistic), chisq_df= chisq_test$parameter, chisq_p_value = ifelse(chisq_test$p.value<.001, "<0.001", sprintf("%1.4f", chisq_test$p.value)), cramers_v = sprintf("%1.2f", cramers_v))
}

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#
oneway_anova_effect_size <- function(values, group) {
  # Perform one-way ANOVA
  anova_result <- aov(values ~ group)
  
  # Summarize ANOVA results
  anova_summary <- summary(anova_result)
  
  # Extract sums of squares
  ss_between <- anova_summary[[1]]$"Sum Sq"[1]
  ss_total <- sum(anova_summary[[1]]$"Sum Sq")
  
  # Calculate eta-squared
  eta_squared <- ss_between / ss_total
  
  # Return ANOVA summary and effect size
  list(
    anova_summary = anova_summary,
    eta_squared = eta_squared
  )
}

Resultados

0.b. Descripción tiempo seguimiento

Describir censura incluyendo muerte.

Código
dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time_rec<- ifelse(!is.na(dt_df_filled_quarter_t_desde_primera_adm_expand$death_time)&dt_df_filled_quarter_t_desde_primera_adm_expand$death_time<dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time,
                     dt_df_filled_quarter_t_desde_primera_adm_expand$death_time,
                     dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time)

psych::describe(dt_df_filled_quarter_t_desde_primera_adm_expand$cens_time_rec, quant = c(0.25, 0.75))|> 
  knitr::kable("html", digits=2)
vars n mean sd median trimmed mad min max range skew kurtosis se Q0.25 Q0.75
X1 1 14184 17.79 2 17.98 17.97 1.41 0.01 20 19.99 -4.63 31.99 0.02 17.01 18.91

Tiempo que demora esta sección: 0 minutos

Ahora por mes

Código
dt_df_filled_month_t_desde_primera_adm_expand$cens_time_rec<- ifelse(!is.na(dt_df_filled_month_t_desde_primera_adm_expand$death_time)&dt_df_filled_month_t_desde_primera_adm_expand$death_time<dt_df_filled_month_t_desde_primera_adm_expand$cens_time,
                     dt_df_filled_month_t_desde_primera_adm_expand$death_time,
                     dt_df_filled_month_t_desde_primera_adm_expand$cens_time)

psych::describe(dt_df_filled_month_t_desde_primera_adm_expand$cens_time_rec, quant = c(0.25, 0.75)) |> 
  knitr::kable("html", digits=2)
vars n mean sd median trimmed mad min max range skew kurtosis se Q0.25 Q0.75
X1 1 17081 53.38 6.09 54.01 53.95 4.24 0.03 59.99 59.96 -4.65 31.65 0.05 51.09 56.77

Tiempo que demora esta sección: 0 minutos

0.c. Compilación de todos CQI’s

Código
graph <-
  grViz("
digraph combinatoria {
  graph [rankdir=LR]  // Configuración vertical

  node [shape = rectangle, style = filled, color = lightblue]

  Inicio [style = invisible]  // Nodo Inicio invisible
  Inicio -> {\"HAC\" \"PAM\" \"PAM2\"} [style = invisible, arrowhead = none]  // Flechas iniciales invisibles

  \"HAC\" -> {\"HAC-OM\" \"HAC-LCS\"}
  \"PAM\" -> {\"PAM-OM\" \"PAM-LCS\"}

  \"HAC-OM\" -> {\"HAC-OM-Trimestral\" \"HAC-OM-Mensual\"}
  \"HAC-LCS\" -> {\"HAC-LCS-Trimestral\" \"HAC-LCS-Mensual\"}
  \"PAM-OM\" -> {\"PAM-OM-Trimestral\" \"PAM-OM-Mensual\"}
  \"PAM-LCS\" -> {\"PAM-LCS-Trimestral\" \"PAM-LCS-Mensual\"}
  
  \"PAM2\" -> {\"PAM2-OM\" \"PAM2-LCS\"}

  \"PAM2-OM\" -> {\"PAM2-OM-Trimestral\" \"PAM2-OM-Mensual\"}
  \"PAM2-LCS\" -> {\"PAM2-LCS-Trimestral\" \"PAM2-LCS-Mensual\"}  
}
")
graph

Diagrama de algoritmos y métodos de agrupamiento utilizados

Código
# Exportar a SVG
svg_code <- export_svg(graph)
writeLines(svg_code, "_figs/diagrama_hierarquia.svg")
svg_code <- export_svg(graph)
rsvg_png(charToRaw(svg_code), file = "_figs/diagrama_hierarquia.png")

Tiempo que demora esta sección: 0 minutos

Código
cat("Número de ttos.")
Número de ttos.
Código
n_ttos <-
df_filled2 |> 
    dplyr::filter(run %in% ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$run) |> 
    dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) |> 
    dplyr::group_by(run) |>
    summarise(n=n()) |> pull(n) |> 
    psych::describe(quant = c(0.25, 0.75))

cat("Edad mínima al primer ingreso entre 2018-2021")
Edad mínima al primer ingreso entre 2018-2021
Código
edad_min<-
dt_ing_calendar_quarter_t_desde_primera_adm_dedup |>
    dplyr::filter(quarter == 0) |>
    dplyr::inner_join(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens[,c("run")], by="run") |>
    pull(min_edad_anos) |> 
    psych::describe(quant = c(0.25, 0.75))

cat("Porcentaje de mujeres")
Porcentaje de mujeres
Código
scales::percent(round(prop.table(table(ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$glosa_sexo)),2)[2])
MUJER 
"55%" 
Código
cat("Días en tratamiento")
Días en tratamiento
Código
dias_tto<-
df_filled2 |> 
    dplyr::filter(run %in% ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$run) |> 
    dplyr::select(run, days_elapsed) |> 
    pull(days_elapsed) |> 
    psych::describe(quant = c(0.25, 0.75))

rbind.data.frame(
  cbind.data.frame(var = "Número de ttos.", n_ttos[,-1]),
  cbind.data.frame(var = "Edad mínima de ingreso por paciente", edad_min[,-1]),
  cbind.data.frame(var = "Días en tto.", dias_tto[,-1])
) |>
  `rownames<-`(NULL) |> 
  select(-trimmed, -mad, -range, -se) |> 
  knitr::kable("markdown", caption="Información sobre seguimiento de pacientes", digits=2)
Información sobre seguimiento de pacientes
var n mean sd median min max skew kurtosis Q0.25 Q0.75
Número de ttos. 6626 2.00 1.75 1 1 36 4.91 50.32 1 2
Edad mínima de ingreso por paciente 6626 20.79 4.36 20 15 29 0.37 -1.12 17 24
Días en tto. 13230 13.41 30.29 6 0 1425 18.51 595.65 2 16

Tiempo que demora esta sección: 0 minutos

Código
cat("Diagnósticos")
Diagnósticos
Código
diag_todos<-
    df_filled2 |> 
    dplyr::filter(run %in% ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$run) |> 
    dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) |> 
    dplyr::group_by(run) |>
    #dplyr::filter(row_number() != 1) |>  # Elimina la primera observación de cada run
    dplyr::mutate(
        all_diags = paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse = ", ")
    ) |>
    dplyr::summarise(
        all_diags = first(all_diags),
        fecha_egreso_rec_fmt = first(fecha_egreso_rec_fmt),
        estab_homo = first(estab_homo)
    ) |>
    dplyr::ungroup() |> 
    dplyr::pull(all_diags) |>  # Extraer la columna all_diags como vector
    strsplit(split = ", ") |>  # Separar cada diagnóstico por comas
    unlist()

diag_todos_first_tr<-
    df_filled2 |> 
    dplyr::filter(run %in% ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$run) |> 
    dplyr::select(run, diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11, fecha_egreso_rec_fmt, estab_homo) |> 
    dplyr::group_by(run) |>
    dplyr::filter(row_number() == 1) |>  # me quedo con la primera observación de cada run
    dplyr::mutate(
        all_diags = paste(na.omit(c(diag1, diag2, diag3, diag4, diag5, diag6, diag7, diag8, diag9, diag10, diag11)), collapse = ", ")
    ) |>
    dplyr::summarise(
        all_diags = first(all_diags),
        fecha_egreso_rec_fmt = first(fecha_egreso_rec_fmt),
        estab_homo = first(estab_homo)
    ) |>
    dplyr::ungroup() |> 
    dplyr::pull(all_diags) |>  # Extraer la columna all_diags como vector
    strsplit(split = ", ") |>  # Separar cada diagnóstico por comas
    unlist()
arrange(data.frame(table(diag_todos_first_tr)),-Freq) |> 
    dplyr::filter(grepl("F19",diag_todos_first_tr)) |> pull(Freq) |> sum()
[1] 343
Código
invisible("315 en el primer tratamiento...")

cat("Total")
Total
Código
length(diag_todos)
[1] 22910
Código
# diag_todos Freq
# 1       F192  394
# 2       F191  104
# 3       F199   90
# 4       F193   38
# 5       F195   25
# 6       F190   21
# 7       F198   13
# 8       F197    2
# 9       F196    1

cat("Número de casos F19 y porcentaje")
Número de casos F19 y porcentaje
Código
arrange(data.frame(table(diag_todos)),-Freq) |> 
    dplyr::filter(grepl("F19",diag_todos)) |> pull(Freq) |> sum()
[1] 796
Código
#688
scales::percent(796/22910)
[1] "3%"
Código
head(arrange(data.frame(table(diag_todos)), -Freq) |> dplyr::mutate(perc=scales::percent(Freq/sum(Freq), accuracy=.01)),20) |> 
  knitr::kable("markdown", caption="Diagnósticos más frecuentes, código CIE-10, detalle y frecuencia")
Diagnósticos más frecuentes, código CIE-10, detalle y frecuencia
diag_todos Freq perc
F329 1089 4.75%
F322 959 4.19%
F609 846 3.69%
F603 606 2.65%
F432 548 2.39%
F209 449 1.96%
F192 432 1.89%
F319 399 1.74%
Z915 391 1.71%
F200 304 1.33%
F323 258 1.13%
F29X 249 1.09%
F121 222 0.97%
F101 208 0.91%
F419 202 0.88%
F142 185 0.81%
F321 179 0.78%
F102 170 0.74%
F171 167 0.73%
T509 163 0.71%
Código
# **F329 (n=990 a 1089)** – *Episodio depresivo no especificado.*  
# Se refiere a un cuadro depresivo cuyos síntomas no cumplen criterios completos para especificar la gravedad o características particulares.
# **F322 (n=845 a 959)** – *Episodio depresivo grave sin síntomas psicóticos.*  
# Episodio depresivo intenso que no presenta alucinaciones ni ideas delirantes, pero con afectación significativa del funcionamiento.
# **F609 (n=770 a 846)** – *Trastorno de la personalidad sin especificar.*  
# Diagnóstico que incluye rasgos de personalidad patológicos que no se ajustan a categorías específicas conocidas.
# **F603 (n=550 a 606)** – *Trastorno de la personalidad emocionalmente inestable (tipo límite).*  
# También llamado “trastorno límite de la personalidad”, caracterizado por inestabilidad emocional, relaciones interpersonales conflictivas y conducta impulsiva.
# **F432 (n=491 a 548)** – *Trastornos de adaptación.*  
# Reacciones emocionales y/o conductuales que surgen como respuesta a un cambio o factor estresante identificable, dificultando la adaptación normal.
# **F209 (n=433 a 449)** – *Esquizofrenia no especificada.*  
# Forma de esquizofrenia en la que no se pueden determinar subtipos (paranoide, catatónica, etc.) o faltan detalles para clasificarlos.
# **F192 (n=394 a 432)** – *Síndrome de dependencia por uso de múltiples drogas.*  
# Dependencia y uso problemático de diversas sustancias psicoactivas, con patrones de consumo repetitivo y dificultades para el control.
# **F319 (n=369 a 399)** – *Trastorno bipolar no especificado.*  
# Forma de trastorno bipolar con episodios de alteración del estado de ánimo, donde faltan datos para clasificar un subtipo específico.
# **Z915 (n=360 a 391)** – *Antecedentes personales de autolesiones.*  
# Historia previa de conducta autolesiva o intento de suicidio, utilizada para codificar factores influyentes en el estado de salud actual.
# **F200 (n=292 a 304)** – *Esquizofrenia paranoide.*  
# Subtipo de esquizofrenia caracterizado principalmente por la presencia de delirios y alucinaciones de tipo paranoide.
# **F29X (n=232 a 249)** – *Psicosis no orgánica no especificada.*  
# Trastorno psicótico sin evidencia de causa orgánica, cuyos rasgos no son suficientes para un diagnóstico más preciso.
# **F323 (n=230 a 258)** – *Episodio depresivo grave con síntomas psicóticos.*  
# Episodio depresivo intenso que incluye delirios, alucinaciones u otras manifestaciones psicóticas.
# **F121 (n=200 a 222)** – *Uso perjudicial de cannabis.*  
# Consumo de cannabis que causa un deterioro en el funcionamiento personal o social, sin llegar al síndrome de dependencia.
# **F101 (n=187 a 208)** – *Uso perjudicial de alcohol.*  
# Patrón de consumo de alcohol que provoca daño a la salud física o mental, sin cumplir criterios de dependencia.
# **F419 (n=176 a 202)** – *Trastorno de ansiedad no especificado.*  
# Ansiedad significativa y persistente que no se encuadra en categorías específicas (p.ej. fobias, pánico, etc.).
# **F142 (n=164 a 185)** – *Síndrome de dependencia de cocaína.*  
# Presencia de dependencia a la cocaína, con anhelo intenso y dificultad para controlar o interrumpir el consumo.
# **F321 (n=163 a 179)** – *Episodio depresivo moderado.*  
# Estado depresivo con síntomas clínicamente relevantes, pero de gravedad intermedia entre leve y grave.
# **F102 (n=157 a 170)** – *Síndrome de dependencia de alcohol.*  
# Patrón de dependencia caracterizado por la necesidad imperiosa de beber y dificultad para controlar el consumo.
# **F171 (n=167)** – *Uso perjudicial de tabaco.*  
# Consumo de tabaco que genera consecuencias físicas o mentales negativas, sin cumplir criterios de dependencia.

Tiempo que demora esta sección: 0.1 minutos

El algoritmo PAM busca formar clústeres de manera eficiente, pero puede dar resultados poco generalizables si parte de medoides iniciales poco adecuados. Para evitar esto, generamos una solución de medoides utilizando como punto de partida los clústeres obtenidos previamente con un método jerárquico.

Exportamos .RDS para generar las pruebas de permutaciones.

Código
invisible("Created ")
pamRange_quarter_om2 <- wcKMedRange(dist_quarter_om, kvals=2:15,  initialclust = om_dist_quarter)
pamRange_quarter_lcs2 <- wcKMedRange(dist_quarter_lcs, kvals=2:15,  initialclust = lcs_dist_quarter)

pamRange_month_om2<- wcKMedRange(dist_month_om, kvals= 2:15, initialclust= lcs_dist_month)
pamRange_month_lcs2<- wcKMedRange(dist_month_lcs, kvals= 2:15, initialclust= lcs_dist_month)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

saveRDS(df_filled2, "_perm/df_filled2.rds")
saveRDS(States_Wide.seq_month_t_prim_adm, "_perm/States_Wide.seq_month_t_prim_adm.rds")
saveRDS(States_Wide.seq_quarter_t_prim_adm, "_perm/States_Wide.seq_quarter_t_prim_adm.rds")
saveRDS(om_dist_month, "_perm/om_dist_month.rds")
saveRDS(lcs_dist_month, "_perm/lcs_dist_month.rds")
saveRDS(om_dist_quarter, "_perm/om_dist_quarter.rds")
saveRDS(lcs_dist_quarter, "_perm/lcs_dist_quarter.rds")
saveRDS(om_dist_month_c, "_perm/om_dist_month_c.rds")
saveRDS(om_dist_quarter_c, "_perm/om_dist_quarter_c.rds")
saveRDS(lcs_dist_month_c, "_perm/lcs_dist_month_c.rds")
saveRDS(lcs_dist_quarter_c, "_perm/lcs_dist_quarter_c.rds")
saveRDS(pamRange_month_om, "_perm/pamRange_month_om.rds")
saveRDS(pamRange_month_om2, "_perm/pamRange_month_om2.rds")
saveRDS(pamRange_quarter_om, "_perm/pamRange_quarter_om.rds")
saveRDS(pamRange_quarter_om2, "_perm/pamRange_quarter_om2.rds")
saveRDS(pamRange_month_lcs, "_perm/pamRange_month_lcs.rds")
saveRDS(pamRange_month_lcs2, "_perm/pamRange_month_lcs2.rds")
saveRDS(pamRange_quarter_lcs, "_perm/pamRange_quarter_lcs.rds")
saveRDS(pamRange_quarter_lcs2, "_perm/pamRange_quarter_lcs2.rds")
saveRDS(costmatrix_month, "_perm/costmatrix_month.rds")
saveRDS(costmatrix_quarter, "_perm/costmatrix_quarter.rds")
saveRDS(dist_month_om, "_perm/dist_month_om.rds")
saveRDS(dist_month_lcs, "_perm/dist_month_lcs.rds")
saveRDS(dist_quarter_om, "_perm/dist_quarter_om.rds")
saveRDS(dist_quarter_lcs, "_perm/dist_quarter_lcs.rds")

Tiempo que demora esta sección: 0.1 minutos

Eliminamos objetos anteriores y conservamos todo lo estrictamente necesario para reducir la carga computacional.

Código
objetos_conservar <- c(
  "dt_ing_calendar_quarter_t_desde_primera_adm_dedup",
  "dt_ing_calendar_month_t_desde_primera_adm_dedup",
  "ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens",
  "ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens",
  "data_long_establecimiento_2024_std",
  "df_filled2",
  "States_Wide.seq_quarter_t_prim_adm_RM_cens",
  "States_Wide.seq_quarter_t_prim_adm_cens",
  "States_Wide.seq_quarter_t_prim_adm",
  "States_Wide.seq_month_t_prim_adm_RM_cens",
  "States_Wide.seq_month_t_prim_adm_cens",
  "States_Wide.seq_month_t_prim_adm",
  "om_dist_month",
  "lcs_dist_month",
  "om_dist_quarter",
  "lcs_dist_quarter",
  "om_dist_month_c",
  "om_dist_quarter_c",
  "lcs_dist_month_c",
  "lcs_dist_quarter_c",
  "pamRange_month_om",
  "pamRange_month_om2",
  "pamRange_quarter_om",
  "pamRange_quarter_om2",
  "pamRange_month_lcs",
  "pamRange_month_lcs2",
  "pamRange_quarter_lcs",
  "pamRange_quarter_lcs2",
  "costmatrix_month",
  "costmatrix_quarter",
  "dist_month_om",
  "dist_month_lcs",
  "dist_quarter_om",
  "dist_quarter_lcs", 
  "as.data.frame.TableOne",
  "best_subset_multnom",
  # "best_subset_multnom_interactions",
  # "best_subset_multinom_interactions_parallel",
  "chisq_cramerv",
  "fisher_posthoc_all_cols",
  "format_cells",
  "format_table_vec",
  "frobenius_norm",
  "func_tab_range_clus",
  "mutinom_pivot_wider",
  "oneway_anova_effect_size",
  "print.seqnullcqi.powder",
  "save_base_plot_as_grob",
  "seq_mean_t_dos_grupos",
  "smd_bin"
)



# Eliminar otros objetos
rm(list = setdiff(ls(), objetos_conservar))

Tiempo que demora esta sección: 0 minutos

0.c.1. Trimestral

Código
perm_trim <- new.env()
invisible("if some of the files is corrupted")
perm_trim_alt<-new.env()
cat("En caso que las variables fueran corruptas producto de problemas computacionales\n")
load("_perm/prueba.RData", envir= perm_trim_alt)

options(width = 1e4) #para ampliar la vista del capture output
load("_perm/null_ssa_hc_quarter_om_comb_20250319.Rda", envir = perm_trim)
hac_om_quarter_null_comb_stats<-perm_trim$om_quarter_null_comb$stats
hac_om_quarter_null_comb_print<-print.seqnullcqi.powder(perm_trim$om_quarter_null_comb)
plot(perm_trim$om_quarter_null_comb, "ASW")
hac_om_quarter_null_comb_plot_asw <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "ASW", type="density")
hac_om_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "HC")
hac_om_quarter_null_comb_plot_hc <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "HC", type="density")
hac_om_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "HG")
hac_om_quarter_null_comb_plot_hg <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "HG", type="density")
hac_om_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "PBC")
hac_om_quarter_null_comb_plot_pbc <- recordPlot()
plot(perm_trim$om_quarter_null_comb, "PBC", type="density")
hac_om_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(om_quarter_null_comb, envir = perm_trim)

load("_perm/null_ssa_hc_quarter_om_seq_20250319.Rda", envir = perm_trim)
hac_om_quarter_null_seq_stats<-perm_trim$om_quarter_null_seq$stats
hac_om_quarter_null_seq_print<-print.seqnullcqi.powder(perm_trim$om_quarter_null_seq)
plot(perm_trim$om_quarter_null_seq, "ASW")
hac_om_quarter_null_seq_plot_asw <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "HC")
hac_om_quarter_null_seq_plot_hc <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "HG")
hac_om_quarter_null_seq_plot_hg <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "PBC")
hac_om_quarter_null_seq_plot_pbc <- recordPlot()

plot(perm_trim$om_quarter_null_seq, "ASW", type="density")
hac_om_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "HC", type="density")
hac_om_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "HG", type="density")
hac_om_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(perm_trim$om_quarter_null_seq, "PBC", type="density")
hac_om_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(om_quarter_null_seq, envir = perm_trim)

load("_perm/null_ssa_hc_quarter_lcs_comb_20250319.Rda", envir = perm_trim)
hac_lcs_quarter_null_comb_stats<-perm_trim$lcs_quarter_null_comb$stats
hac_lcs_quarter_null_comb_print<-print.seqnullcqi.powder(perm_trim$lcs_quarter_null_comb)
plot(perm_trim$lcs_quarter_null_comb, "ASW")
hac_lcs_quarter_null_comb_plot_asw <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "HC")
hac_lcs_quarter_null_comb_plot_hc <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "HG")
hac_lcs_quarter_null_comb_plot_hg <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "PBC")
hac_lcs_quarter_null_comb_plot_pbc <- recordPlot()

plot(perm_trim$lcs_quarter_null_comb, "ASW", type="density")
hac_lcs_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "HC", type="density")
hac_lcs_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "HG", type="density")
hac_lcs_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(perm_trim$lcs_quarter_null_comb, "PBC", type="density")
hac_lcs_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(lcs_quarter_null_comb, envir = perm_trim)

# tryCatch({
#   load("_perm/null_ssa_hc_quarter_lcs_seq_20250319.Rda", envir = perm_trim)#CORRUPTO
# }, error = function(e) {
#   # Handle the error if loading fails
#   message(paste("Error loading file:", e$message))
#   perm_trim$lcs_quarter_null_seq<- perm_trim_alt$pam_om_quarter_null_comb
# })
load("_perm/null_ssa_hc_quarter_lcs_seq_20250319.Rda", envir = perm_trim)
hac_lcs_quarter_null_seq_stats<-perm_trim$lcs_quarter_null_seq$stats
hac_lcs_quarter_null_seq_print<-print.seqnullcqi.powder(perm_trim$lcs_quarter_null_seq)
plot(perm_trim$lcs_quarter_null_seq, "ASW")
hac_lcs_quarter_null_seq_plot_asw <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "HC")
hac_lcs_quarter_null_seq_plot_hc <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "HG")
hac_lcs_quarter_null_seq_plot_hg <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "PBC")
hac_lcs_quarter_null_seq_plot_pbc <- recordPlot()

plot(perm_trim$lcs_quarter_null_seq, "ASW", type="density")
hac_lcs_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "HC", type="density")
hac_lcs_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "HG", type="density")
hac_lcs_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(perm_trim$lcs_quarter_null_seq, "PBC", type="density")
hac_lcs_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(lcs_quarter_null_seq, envir = perm_trim)

invisible("no funciona: nul incrustado en la cadena")
#https://stackoverflow.com/questions/45489737/getting-embedded-nul-in-string-in-an-rdata-file-is-the-rdata-file-format-po

load("_perm/null_ssa_pam_quarter_om_comb_20250319.Rda", envir = perm_trim) 
pam_om_quarter_null_comb_stats<-perm_trim$pam_om_quarter_null_comb$stats
pam_om_quarter_null_comb_print<-print.seqnullcqi.powder(perm_trim$pam_om_quarter_null_comb)
plot(perm_trim$pam_om_quarter_null_comb, "ASW")
pam_om_quarter_null_comb_plot_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "HC")
pam_om_quarter_null_comb_plot_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "HG")
pam_om_quarter_null_comb_plot_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "PBC")
pam_om_quarter_null_comb_plot_pbc <- recordPlot()

plot(perm_trim$pam_om_quarter_null_comb, "ASW", type="density")
pam_om_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "HC", type="density")
pam_om_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "HG", type="density")
pam_om_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb, "PBC", type="density")
pam_om_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_comb, envir = perm_trim)

load("_perm/null_ssa_pam_quarter_om_seq_20250319.Rda", envir = perm_trim)
pam_om_quarter_null_seq_stats<-perm_trim$pam_om_quarter_null_seq$stats
pam_om_quarter_null_seq_print<-print.seqnullcqi.powder(perm_trim$pam_om_quarter_null_seq)
plot(perm_trim$pam_om_quarter_null_seq, "ASW")
pam_om_quarter_null_seq_plot_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "HC")
pam_om_quarter_null_seq_plot_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "HG")
pam_om_quarter_null_seq_plot_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "PBC")
pam_om_quarter_null_seq_plot_pbc <- recordPlot()

plot(perm_trim$pam_om_quarter_null_seq, "ASW", type="density")
pam_om_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "HC", type="density")
pam_om_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "HG", type="density")
pam_om_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq, "PBC", type="density")
pam_om_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_seq, envir = perm_trim)

load("_perm/null_ssa_pam_quarter_lcs_comb_20250319.Rda", envir = perm_trim)
pam_lcs_quarter_null_comb_stats<-perm_trim$pam_lcs_quarter_null_comb$stats
pam_lcs_quarter_null_comb_print<-print.seqnullcqi.powder(perm_trim$pam_lcs_quarter_null_comb)
plot(perm_trim$pam_lcs_quarter_null_comb, "ASW")
pam_lcs_quarter_null_comb_plot_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "HC")
pam_lcs_quarter_null_comb_plot_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "HG")
pam_lcs_quarter_null_comb_plot_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "PBC")
pam_lcs_quarter_null_comb_plot_pbc <- recordPlot()

plot(perm_trim$pam_lcs_quarter_null_comb, "ASW", type="density")
pam_lcs_quarter_null_comb_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "HC", type="density")
pam_lcs_quarter_null_comb_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "HG", type="density")
pam_lcs_quarter_null_comb_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb, "PBC", type="density")
pam_lcs_quarter_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_comb, envir = perm_trim)


load("_perm/null_ssa_pam_quarter_lcs_seq_20250319.Rda", envir = perm_trim)
pam_lcs_quarter_null_seq_stats<-perm_trim$pam_lcs_quarter_null_seq$stats
pam_lcs_quarter_null_seq_print<-print.seqnullcqi.powder(perm_trim$pam_lcs_quarter_null_seq)
plot(perm_trim$pam_lcs_quarter_null_seq, "ASW")
pam_lcs_quarter_null_seq_plot_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "HC")
pam_lcs_quarter_null_seq_plot_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "HG")
pam_lcs_quarter_null_seq_plot_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "PBC")
pam_lcs_quarter_null_seq_plot_pbc <- recordPlot()

plot(perm_trim$pam_lcs_quarter_null_seq, "ASW", type="density")
pam_lcs_quarter_null_seq_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "HC", type="density")
pam_lcs_quarter_null_seq_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "HG", type="density")
pam_lcs_quarter_null_seq_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq, "PBC", type="density")
pam_lcs_quarter_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_seq, envir = perm_trim)

tryCatch({
  load("_perm/null_ssa_pam_quarter_om_comb2_20250319.Rda", envir = perm_trim) #CORRUPTO
}, error = function(e) {
  # Handle the error if loading fails
  message(paste("Error loading file:", e$message))
  perm_trim$pam_om_quarter_null_comb2<- perm_trim_alt$pam_om_quarter_null_comb2
})
pam_om_quarter_null_comb2_stats<-perm_trim$pam_om_quarter_null_comb2$stats
pam_om_quarter_null_comb2_print<-print.seqnullcqi.powder(perm_trim$pam_om_quarter_null_comb2)
plot(perm_trim$pam_om_quarter_null_comb2, "ASW")
pam_om_quarter_null_comb2_plot_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "HC")
pam_om_quarter_null_comb2_plot_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "HG")
pam_om_quarter_null_comb2_plot_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "PBC")
pam_om_quarter_null_comb2_plot_pbc <- recordPlot()

plot(perm_trim$pam_om_quarter_null_comb2, "ASW", type="density")
pam_om_quarter_null_comb2_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "HC", type="density")
pam_om_quarter_null_comb2_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "HG", type="density")
pam_om_quarter_null_comb2_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_comb2, "PBC", type="density")
pam_om_quarter_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_comb2, envir = perm_trim)

load("_perm/null_ssa_pam_quarter_om_seq2_20250319.Rda", envir = perm_trim)
pam_om_quarter_null_seq2_stats<-perm_trim$pam_om_quarter_null_seq2$stats
pam_om_quarter_null_seq2_print<-print.seqnullcqi.powder(perm_trim$pam_om_quarter_null_seq2)
plot(perm_trim$pam_om_quarter_null_seq2, "ASW")
pam_om_quarter_null_seq2_plot_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "HC")
pam_om_quarter_null_seq2_plot_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "HG")
pam_om_quarter_null_seq2_plot_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "PBC")
pam_om_quarter_null_seq2_plot_pbc <- recordPlot()

plot(perm_trim$pam_om_quarter_null_seq2, "ASW", type="density")
pam_om_quarter_null_seq2_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "HC", type="density")
pam_om_quarter_null_seq2_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "HG", type="density")
pam_om_quarter_null_seq2_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_om_quarter_null_seq2, "PBC", type="density")
pam_om_quarter_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_om_quarter_null_seq2, envir = perm_trim)
# load("_perm/null_ssa_pam_quarter_lcs_comb2_2020319.Rda", envir = perm_trim)

load("_perm/null_ssa_pam_quarter_lcs_comb2_20250319.Rda", envir = perm_trim)
pam_lcs_quarter_null_comb2_stats<-perm_trim$pam_lcs_quarter_null_comb2$stats
pam_lcs_quarter_null_comb2_print<-print.seqnullcqi.powder(perm_trim$pam_lcs_quarter_null_comb2)
plot(perm_trim$pam_lcs_quarter_null_comb2, "ASW")
pam_lcs_quarter_null_comb2_plot_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "HC")
pam_lcs_quarter_null_comb2_plot_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "HG")
pam_lcs_quarter_null_comb2_plot_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "PBC")
pam_lcs_quarter_null_comb2_plot_pbc <- recordPlot()

plot(perm_trim$pam_lcs_quarter_null_comb2, "ASW", type="density")
pam_lcs_quarter_null_comb2_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "HC", type="density")
pam_lcs_quarter_null_comb2_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "HG", type="density")
pam_lcs_quarter_null_comb2_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_comb2, "PBC", type="density")
pam_lcs_quarter_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_comb2, envir = perm_trim)

load("_perm/null_ssa_pam_quarter_lcs_seq2_20250319.Rda", envir = perm_trim)
pam_lcs_quarter_null_seq2_stats<-perm_trim$pam_lcs_quarter_null_seq2$stats
pam_lcs_quarter_null_seq2_print<-print.seqnullcqi.powder(perm_trim$pam_lcs_quarter_null_seq2)
plot(perm_trim$pam_lcs_quarter_null_seq2, "ASW")
pam_lcs_quarter_null_seq2_plot_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "HC")
pam_lcs_quarter_null_seq2_plot_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "HG")
pam_lcs_quarter_null_seq2_plot_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "PBC")
pam_lcs_quarter_null_seq2_plot_pbc <- recordPlot()

plot(perm_trim$pam_lcs_quarter_null_seq2, "ASW", type="density")
pam_lcs_quarter_null_seq2_plot_dens_asw <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "HC", type="density")
pam_lcs_quarter_null_seq2_plot_dens_hc <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "HG", type="density")
pam_lcs_quarter_null_seq2_plot_dens_hg <- recordPlot()
plot(perm_trim$pam_lcs_quarter_null_seq2, "PBC", type="density")
pam_lcs_quarter_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_quarter_null_seq2, envir = perm_trim)

options(width = getOption("width"))

rm(perm_trim)
rm(perm_trim_alt)

Tiempo que demora esta sección: 0.1 minutos

Código
cqi_quarter<-
rbind.data.frame(
cbind.data.frame(algo="hac", type="om", time="quarter", k=2:15, corr=F, om_dist_quarter_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="hac", type="lcs", time="quarter", k=2:15, corr=F, lcs_dist_quarter_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="quarter", k=2:15, corr=F, pamRange_quarter_om$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="quarter", k=2:15, corr=T, pamRange_quarter_om2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="quarter", k=2:15, corr=F, pamRange_quarter_lcs$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="quarter", k=2:15, corr=T, pamRange_quarter_lcs2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2)))
)|> 
  dplyr::select(algo, type, time, k, corr, PBC, ASW, HC, HG, R2, R2sq)
# round(summary(silhouette(as.integer(om_dist_quarter_c$clustering$cluster2), as.dist(dist_quarter_om)))$clus.avg.widths,2)[attr(rev(sort(table(om_dist_quarter_c$clustering$cluster2))),"names")]

#functión para generar el gráfico
tabs_quarter_clus_sol<-
rbind.data.frame(
func_tab_range_clus(om_dist_quarter_c),
func_tab_range_clus(lcs_dist_quarter_c),
func_tab_range_clus(pamRange_quarter_om),
func_tab_range_clus(pamRange_quarter_om2),
func_tab_range_clus(pamRange_quarter_lcs),
func_tab_range_clus(pamRange_quarter_lcs2)
)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
##:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

# Inicializamos una lista para almacenar los resultados
resultados_list <- list()
# Definimos un rango para los clusters a evaluar
cluster_range <- 2:15
# Definimos los métodos y sus variables
metodos <- list(
    hac_om = list(data = om_dist_quarter_c, dist = dist_quarter_om),
    hac_lcs = list(data = lcs_dist_quarter_c, dist = dist_quarter_lcs),
    pam_om0 = list(data = pamRange_quarter_om, dist = dist_quarter_om),
    pam_om1 = list(data = pamRange_quarter_om2, dist = dist_quarter_om),
    pam_lcs0 = list(data = pamRange_quarter_lcs, dist = dist_quarter_lcs),
    pam_lcs1 = list(data = pamRange_quarter_lcs2, dist = dist_quarter_lcs)
)
# Número máximo de clusters para definir las columnas
max_clusters <- max(cluster_range)
# Iteramos sobre cada método
for (metodo in names(metodos)) {
    # Creamos un data frame temporal para cada método
    metodo_result <- data.frame()
    # Iteramos sobre cada cluster en el rango
    for (cluster in cluster_range) {
        # Construimos el nombre del cluster dinámicamente
        cluster_name <- paste0("cluster", cluster)
        # Intentamos calcular los valores de silhouette
        silhouette_values <- tryCatch(
            round(summary(silhouette(as.integer(metodos[[metodo]]$data$clustering[[cluster_name]]), as.dist(metodos[[metodo]]$dist)))$clus.avg.widths[attr(rev(sort(table(metodos[[metodo]]$data$clustering[[cluster_name]]))),"names")], 2),
            error = function(e) rep(NA, cluster)
        )
        # Creamos un vector con las columnas llenando con NA si faltan valores
        silhouette_full <- c(silhouette_values, rep(NA, max_clusters - length(silhouette_values)))
        # Creamos un data frame temporal con los resultados para este cluster
        cluster_result <- data.frame(
            Metodo = metodo,
            Cluster = cluster,
            t(silhouette_full) # Transponemos los valores para que cada uno sea una columna
        )
        # Nombramos dinámicamente las columnas de silhouette
        colnames(cluster_result)[3:(3 + max_clusters - 1)] <- paste0("asw", 1:max_clusters)
        # Añadimos el resultado del cluster al data frame del método
        metodo_result <- rbind(metodo_result, cluster_result)
    }
    # Agregamos los resultados del método a la lista general
    resultados_list[[metodo]] <- metodo_result
}
# Combinamos todos los resultados en un único data frame
avs_por_cluster_quarter <- do.call(rbind, resultados_list)
# Ordenamos por Método y Cluster
avs_por_cluster_quarter <- avs_por_cluster_quarter[order(avs_por_cluster_quarter$Metodo, avs_por_cluster_quarter$Cluster), ]

bind_cols(cqi_quarter, tabs_quarter_clus_sol)|>
  dplyr::mutate(corr= dplyr::case_when(corr==TRUE & algo!="hac"~"1",corr==FALSE & algo!="hac"~"0",T~""), key= paste0(algo,"_",type,corr,"_",k))|> 
  left_join(dplyr::mutate(avs_por_cluster_quarter, key=paste0(Metodo,"_",Cluster)), by="key") |> 
  dplyr::select(-Metodo, -Cluster) |> 
            `rownames<-`(NULL) |>
  dplyr::mutate(calc= round(PBC*(1/HC)*HG,2)) |> 
  dplyr::arrange(desc(ASW)) |>
  dplyr::select(c("algo", "type", "time", "k", "corr", "PBC", "ASW", "HC", "HG", "R2", "R2sq", "calc", paste0("X",1:15), paste0("asw",1:15))) |> 
  (\(df) {
    assign("asw_quarter_qci", dplyr::select(df, -"time"), envir = .GlobalEnv)
    rio::export(df, "_output/sol_conglomerados_tab_quarter_25.xlsx")            
    knitr::kable(df, "markdown", caption = "CQIs y frecuencias en conglomerados (trimestre)")
  })()
CQIs y frecuencias en conglomerados (trimestre)
algo type time k corr PBC ASW HC HG R2 R2sq calc X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 asw1 asw2 asw3 asw4 asw5 asw6 asw7 asw8 asw9 asw10 asw11 asw12 asw13 asw14 asw15
pam om quarter 6 0 0.59 0.59 0.10 0.77 0.38 0.49 4.54 4885 746 358 239 224 174 0.66 0.62 0.22 -0.03 0.49 -0.05
pam om quarter 14 0 0.59 0.59 0.06 0.85 0.51 0.59 8.36 4121 745 258 220 169 167 153 147 127 113 107 102 100 97 0.74 0.57 0.23 0.47 0.05 0.26 -0.13 0.06 0.38 -0.06 0.39 0.49 0.34 0.40
pam om quarter 15 0 0.60 0.59 0.05 0.86 0.52 0.59 10.32 4042 745 258 220 169 167 153 147 127 111 107 102 100 94 84 0.76 0.57 0.22 0.46 0.04 0.25 -0.13 0.05 0.37 -0.06 0.38 0.48 0.34 0.43 0.32
pam om quarter 6 1 0.59 0.59 0.10 0.77 0.38 0.49 4.54 4885 746 358 239 224 174 0.66 0.62 0.22 -0.03 0.49 -0.05
pam om quarter 7 1 0.59 0.59 0.10 0.78 0.40 0.51 4.60 4729 746 353 224 212 189 173 0.68 0.61 0.22 0.48 0.04 0.20 -0.05
hac om quarter 4 0.50 0.58 0.19 0.66 0.28 0.36 1.74 5352 738 312 224 0.61 0.66 -0.15 0.52
hac om quarter 5 0.50 0.58 0.19 0.66 0.30 0.40 1.74 5352 738 277 224 35 0.61 0.66 -0.04 0.52 -0.04
pam om quarter 4 0 0.49 0.58 0.20 0.66 0.30 0.37 1.62 5248 750 399 229 0.62 0.62 0.08 0.48
pam om quarter 5 0 0.55 0.58 0.14 0.72 0.34 0.45 2.83 5119 746 361 224 176 0.62 0.63 0.23 0.50 -0.04
pam om quarter 9 0 0.59 0.58 0.09 0.80 0.44 0.54 5.24 4495 746 351 222 173 169 159 156 155 0.69 0.60 0.18 0.49 0.12 0.33 -0.08 0.21 0.10
pam om quarter 10 0 0.59 0.58 0.09 0.81 0.45 0.55 5.31 4380 745 351 221 172 169 159 155 153 121 0.70 0.59 0.17 0.48 0.11 0.32 -0.09 0.09 0.21 0.26
pam om quarter 13 0 0.60 0.58 0.06 0.84 0.49 0.58 8.40 4204 745 258 221 169 167 153 147 127 117 116 102 100 0.72 0.58 0.25 0.47 0.06 0.27 -0.13 0.07 0.39 0.30 -0.06 0.51 0.34
pam om quarter 4 1 0.49 0.58 0.20 0.66 0.30 0.37 1.62 5248 750 399 229 0.62 0.62 0.08 0.48
pam om quarter 5 1 0.55 0.58 0.14 0.72 0.34 0.45 2.83 5119 746 361 224 176 0.62 0.63 0.23 0.50 -0.04
pam om quarter 8 1 0.61 0.58 0.08 0.82 0.42 0.52 6.25 4583 746 336 226 212 178 173 172 0.69 0.60 0.21 0.45 0.00 -0.08 0.30 -0.08
pam om quarter 13 1 0.60 0.58 0.06 0.84 0.50 0.58 8.40 4204 745 258 221 165 152 144 143 134 128 122 110 100 0.71 0.58 0.25 0.47 0.02 -0.05 0.27 0.09 0.52 0.18 -0.14 0.57 0.34
pam om quarter 14 1 0.59 0.58 0.06 0.85 0.51 0.59 8.36 4121 745 258 220 165 152 148 146 128 120 114 107 102 100 0.73 0.57 0.24 0.47 0.00 -0.13 0.05 0.27 0.59 0.12 -0.06 0.60 0.40 0.34
pam om quarter 15 1 0.60 0.58 0.05 0.86 0.52 0.59 10.32 4042 745 258 220 165 152 148 146 126 111 106 106 101 100 100 0.75 0.57 0.23 0.46 -0.02 -0.14 0.04 0.22 0.60 -0.05 0.61 0.30 0.11 0.34 0.42
hac lcs quarter 15 0.56 0.57 0.02 0.95 0.55 0.65 26.60 3327 894 485 454 257 256 237 203 202 100 85 80 30 10 6 1.00 -0.13 1.00 -0.07 -0.23 0.12 0.16 0.02 0.36 0.02 -0.03 -0.07 0.00 0.19 0.51
pam om quarter 7 0 0.59 0.57 0.10 0.78 0.40 0.51 4.60 4729 746 353 225 224 176 173 0.66 0.61 0.22 -0.01 0.48 0.30 -0.06
pam om quarter 8 0 0.59 0.57 0.09 0.80 0.42 0.52 5.24 4612 746 351 222 212 169 159 155 0.67 0.60 0.19 0.49 0.01 0.35 -0.07 0.11
pam om quarter 11 0 0.58 0.57 0.08 0.81 0.47 0.55 5.87 4308 745 351 221 171 169 159 148 130 121 103 0.69 0.59 0.15 0.48 0.08 0.28 -0.09 0.10 0.37 0.25 0.52
pam om quarter 12 0 0.58 0.57 0.08 0.81 0.48 0.56 5.87 4308 745 258 221 171 169 153 147 130 121 103 100 0.69 0.59 0.26 0.48 0.08 0.28 -0.10 0.09 0.37 0.25 0.52 0.34
pam om quarter 9 1 0.60 0.57 0.08 0.82 0.44 0.54 6.15 4460 746 336 226 200 174 172 158 154 0.69 0.59 0.19 0.44 -0.03 -0.08 -0.08 0.42 0.22
pam om quarter 10 1 0.61 0.57 0.07 0.84 0.46 0.55 7.32 4369 744 350 223 191 160 154 152 142 141 0.71 0.59 0.16 0.46 -0.02 -0.15 0.43 -0.05 0.13 0.32
hac lcs quarter 13 0.54 0.56 0.03 0.92 0.53 0.63 16.56 3327 1348 485 257 256 237 203 202 130 85 80 10 6 1.00 -0.16 1.00 -0.23 0.12 0.18 0.03 0.36 -0.08 -0.02 -0.03 0.19 0.54
hac lcs quarter 14 0.54 0.56 0.03 0.93 0.54 0.64 16.74 3327 1348 485 257 256 237 203 202 100 85 80 30 10 6 1.00 -0.16 1.00 -0.23 0.12 0.18 0.02 0.36 0.02 -0.03 -0.03 0.00 0.19 0.51
pam om quarter 11 1 0.58 0.56 0.08 0.81 0.47 0.55 5.87 4308 745 351 221 168 159 148 134 133 130 129 0.67 0.59 0.16 0.48 0.06 -0.09 0.09 0.26 0.16 0.58 0.40
pam om quarter 12 1 0.58 0.56 0.08 0.81 0.48 0.56 5.87 4308 745 258 221 168 153 147 138 130 129 129 100 0.67 0.59 0.27 0.48 0.06 -0.11 0.08 0.24 0.58 0.40 0.17 0.34
hac om quarter 3 0.49 0.55 0.20 0.65 0.24 0.31 1.59 5352 962 312 0.62 0.41 -0.15
pam om quarter 2 0 0.33 0.55 0.34 0.54 0.18 0.22 0.52 5868 758 0.53 0.63
pam om quarter 3 0 0.44 0.55 0.24 0.62 0.24 0.30 1.14 5456 756 414 0.58 0.62 0.07
pam om quarter 2 1 0.33 0.55 0.34 0.54 0.18 0.22 0.52 5868 758 0.53 0.63
pam om quarter 3 1 0.44 0.55 0.24 0.62 0.24 0.30 1.14 5456 756 414 0.58 0.62 0.07
hac om quarter 2 0.36 0.54 0.30 0.55 0.19 0.22 0.66 5664 962 0.56 0.44
pam lcs quarter 9 1 0.58 0.54 0.06 0.91 0.42 0.54 8.80 4560 701 302 273 189 186 185 115 115 0.65 0.54 0.31 -0.09 0.16 0.50 0.08 0.03 -0.08
pam lcs quarter 11 1 0.58 0.54 0.04 0.93 0.45 0.57 13.48 4385 695 299 224 203 193 190 138 128 95 76 0.67 0.54 0.30 -0.22 0.11 0.04 0.49 0.46 0.16 -0.03 -0.07
hac lcs quarter 11 0.54 0.53 0.03 0.92 0.50 0.60 16.56 3327 1348 742 256 237 203 202 130 90 85 6 1.00 -0.16 0.37 0.12 0.18 0.03 0.36 -0.08 -0.09 -0.02 0.54
hac lcs quarter 12 0.54 0.53 0.03 0.92 0.51 0.61 16.56 3327 1348 742 256 237 203 202 130 85 80 10 6 1.00 -0.16 0.37 0.12 0.18 0.03 0.36 -0.08 -0.02 -0.03 0.19 0.54
pam lcs quarter 7 1 0.56 0.53 0.10 0.87 0.37 0.50 4.87 4758 738 307 239 226 198 160 0.62 0.49 0.29 0.02 0.04 0.47 -0.07
pam lcs quarter 8 1 0.57 0.53 0.07 0.89 0.40 0.51 7.25 4604 701 307 274 209 189 187 155 0.64 0.54 0.28 -0.09 0.04 0.17 0.50 -0.07
pam lcs quarter 10 1 0.58 0.53 0.05 0.92 0.43 0.55 10.67 4448 701 302 273 189 185 184 145 112 87 0.66 0.53 0.30 -0.11 0.13 0.09 0.52 -0.09 0.43 0.00
pam lcs quarter 14 1 0.57 0.53 0.03 0.94 0.49 0.59 17.86 4127 695 299 224 203 193 183 140 128 99 86 85 85 79 0.67 0.51 0.28 -0.29 -0.01 0.02 0.50 0.47 0.12 0.75 0.34 -0.08 0.00 0.72
hac om quarter 11 0.55 0.52 0.10 0.79 0.43 0.54 4.35 4210 738 356 344 277 268 224 162 20 15 12 0.69 0.62 0.15 -0.15 -0.16 0.04 0.48 -0.16 0.10 0.07 0.12
hac om quarter 12 0.56 0.52 0.09 0.79 0.44 0.55 4.92 4210 738 356 344 268 224 203 162 74 20 15 12 0.69 0.62 0.14 -0.15 0.04 0.48 -0.08 -0.17 -0.05 0.09 0.07 0.12
hac om quarter 13 0.56 0.52 0.09 0.79 0.44 0.56 4.92 4210 738 356 344 268 224 203 102 74 60 20 15 12 0.69 0.62 0.14 -0.15 0.04 0.47 -0.08 0.06 -0.06 0.07 0.08 0.01 0.12
hac lcs quarter 9 0.51 0.52 0.06 0.86 0.48 0.57 7.31 3327 1807 742 237 202 130 90 85 6 1.00 -0.17 0.38 0.21 0.37 -0.04 -0.03 0.01 0.54
hac lcs quarter 10 0.53 0.52 0.04 0.89 0.49 0.58 11.79 3327 1604 742 237 203 202 130 90 85 6 1.00 -0.16 0.38 0.19 0.03 0.37 -0.07 -0.04 -0.02 0.54
pam lcs quarter 12 0 0.57 0.52 0.04 0.93 0.46 0.57 13.25 4264 742 294 251 201 191 146 126 125 117 85 84 0.65 0.42 -0.08 -0.18 0.62 0.47 -0.09 0.43 0.67 0.36 0.38 0.01
pam lcs quarter 13 0 0.57 0.52 0.04 0.93 0.48 0.57 13.25 4185 742 294 251 201 191 146 133 123 100 92 84 84 0.66 0.40 -0.08 -0.21 0.62 0.46 -0.09 0.55 0.25 0.74 0.53 0.37 0.01
pam lcs quarter 6 1 0.53 0.52 0.13 0.83 0.35 0.45 3.38 4821 739 349 281 241 195 0.61 0.50 0.21 -0.06 0.01 0.49
pam lcs quarter 12 1 0.57 0.52 0.04 0.92 0.46 0.57 13.11 4286 692 300 299 188 183 138 132 125 109 98 76 0.64 0.53 -0.20 0.29 0.49 0.05 0.28 0.14 0.67 0.44 -0.05 -0.07
pam lcs quarter 13 1 0.58 0.52 0.03 0.94 0.48 0.59 18.17 4203 706 299 219 218 192 182 131 110 100 98 92 76 0.67 0.48 0.29 -0.05 -0.13 0.03 0.51 0.12 0.65 0.53 -0.05 0.28 -0.07
hac om quarter 7 0.52 0.51 0.16 0.69 0.35 0.47 2.24 4984 738 356 277 224 35 12 0.55 0.65 0.23 -0.11 0.51 -0.06 0.18
hac om quarter 8 0.53 0.51 0.13 0.71 0.38 0.49 2.89 4640 738 356 344 277 224 35 12 0.60 0.64 0.20 -0.09 -0.12 0.50 -0.06 0.12
hac om quarter 9 0.53 0.51 0.13 0.73 0.40 0.51 2.98 4372 738 356 344 277 268 224 35 12 0.64 0.63 0.17 -0.12 -0.14 0.07 0.48 -0.06 0.12
hac om quarter 10 0.53 0.51 0.13 0.73 0.41 0.52 2.98 4372 738 356 344 277 268 224 20 15 12 0.64 0.63 0.17 -0.12 -0.14 0.07 0.48 0.12 0.10 0.12
hac om quarter 15 0.56 0.51 0.09 0.79 0.47 0.59 4.92 4210 738 268 231 224 203 183 173 113 102 74 60 20 15 12 0.63 0.62 0.02 0.01 0.47 -0.12 0.12 0.75 0.17 0.04 -0.06 0.05 0.07 0.01 0.09
hac lcs quarter 8 0.51 0.51 0.06 0.86 0.47 0.55 7.31 3327 1807 742 237 202 130 91 90 1.00 -0.17 0.38 0.21 0.37 -0.03 -0.03 -0.03
pam lcs quarter 11 0 0.57 0.51 0.05 0.92 0.45 0.56 10.49 4349 742 294 251 201 191 146 126 125 117 84 0.62 0.43 -0.07 -0.16 0.63 0.47 -0.08 0.44 0.67 0.39 0.01
pam lcs quarter 15 1 0.57 0.51 0.03 0.94 0.50 0.60 17.86 4055 695 299 224 193 187 172 134 111 107 99 91 89 85 85 0.65 0.50 0.27 -0.26 0.02 0.47 0.15 0.08 0.20 0.56 0.55 1.00 0.27 -0.08 0.00
hac om quarter 6 0.50 0.50 0.17 0.68 0.34 0.43 2.00 4996 738 356 277 224 35 0.54 0.65 0.23 -0.10 0.51 -0.06
hac om quarter 14 0.56 0.50 0.09 0.79 0.46 0.58 4.92 4210 738 344 268 224 203 183 173 102 74 60 20 15 12 0.63 0.62 -0.15 0.03 0.47 -0.12 0.12 0.75 0.04 -0.06 0.05 0.07 0.01 0.12
hac lcs quarter 7 0.49 0.50 0.08 0.81 0.45 0.52 4.96 3327 2044 742 202 130 91 90 1.00 -0.17 0.38 0.37 -0.01 0.07 -0.01
pam lcs quarter 4 0 0.51 0.50 0.17 0.79 0.27 0.37 2.37 5250 745 379 252 0.56 0.50 0.00 0.04
pam lcs quarter 10 0 0.56 0.50 0.06 0.90 0.43 0.53 8.40 4386 744 318 251 201 190 164 127 125 120 0.61 0.43 -0.10 -0.16 0.64 0.49 -0.07 0.44 0.67 0.35
pam lcs quarter 15 0 0.57 0.50 0.03 0.93 0.50 0.61 17.67 4113 736 290 227 201 191 154 146 115 91 85 83 80 79 35 0.63 0.43 -0.06 -0.12 0.61 0.44 0.11 -0.10 0.27 1.00 0.35 0.01 1.00 0.74 0.05
pam lcs quarter 4 1 0.53 0.50 0.15 0.82 0.27 0.40 2.90 5340 734 350 202 0.55 0.53 0.11 -0.06
pam lcs quarter 3 0 0.45 0.49 0.21 0.74 0.23 0.31 1.59 5502 745 379 0.51 0.52 0.03
pam lcs quarter 5 0 0.51 0.49 0.17 0.80 0.31 0.42 2.40 5016 743 349 263 255 0.57 0.49 0.23 0.02 -0.03
pam lcs quarter 9 0 0.57 0.49 0.06 0.90 0.42 0.53 8.55 4485 744 318 251 201 190 164 155 118 0.60 0.44 -0.10 -0.10 0.64 0.50 -0.07 0.37 0.37
pam lcs quarter 14 0 0.56 0.49 0.04 0.93 0.49 0.58 13.02 4113 742 294 251 201 191 154 146 115 91 85 84 80 79 0.63 0.39 -0.08 -0.23 0.61 0.44 0.11 -0.09 0.27 1.00 0.35 0.01 1.00 0.74
pam lcs quarter 3 1 0.45 0.49 0.21 0.74 0.23 0.31 1.59 5502 739 385 0.51 0.53 0.02
pam lcs quarter 5 1 0.51 0.49 0.17 0.80 0.31 0.41 2.40 5016 739 349 281 241 0.56 0.50 0.23 -0.05 0.04
hac lcs quarter 5 0.48 0.48 0.09 0.78 0.39 0.46 4.16 3529 2044 742 221 90 0.90 -0.13 0.40 -0.04 0.00
hac lcs quarter 6 0.48 0.48 0.09 0.79 0.41 0.50 4.21 3529 2044 742 130 91 90 0.90 -0.13 0.40 0.00 0.07 0.00
pam lcs quarter 8 0 0.56 0.48 0.08 0.89 0.40 0.51 6.23 4604 744 322 251 201 190 159 155 0.56 0.46 -0.10 -0.07 0.65 0.51 -0.07 0.40
hac lcs quarter 4 0.45 0.47 0.12 0.75 0.37 0.42 2.81 3529 2134 742 221 0.90 -0.17 0.40 -0.03
pam lcs quarter 7 0 0.56 0.46 0.10 0.87 0.38 0.49 4.87 4758 744 322 240 204 193 165 0.52 0.48 -0.08 0.02 0.65 0.53 -0.07
hac lcs quarter 3 0.43 0.44 0.19 0.70 0.25 0.33 1.58 4271 2134 221 0.71 -0.06 -0.02
pam lcs quarter 2 0 0.22 0.44 0.44 0.50 0.13 0.14 0.25 5878 748 0.42 0.55
pam lcs quarter 2 1 0.22 0.44 0.44 0.50 0.13 0.14 0.25 5878 748 0.42 0.55
hac lcs quarter 2 0.36 0.43 0.25 0.63 0.20 0.20 0.91 4271 2355 0.75 -0.14
pam lcs quarter 6 0 0.55 0.42 0.13 0.84 0.34 0.46 3.55 4949 744 322 251 201 159 0.47 0.48 -0.08 0.01 0.67 -0.06

Tiempo que demora esta sección: 0 minutos

Para validar la robustez de esta tipología, se implementó un procedimiento de bootstrap paramétrico con 1000 réplicas, comparando la calidad de la solución observada con la obtenida al aplicar el mismo procedimiento de clustering a datos generados bajo un modelo nulo combinado. Este modelo nulo evalúa la calidad de la agrupación en ausencia de estructura real, considerando aspectos combinados de duración y secuencia (comb), así como la secuencia por sí sola (seq), según la metodología propuesta por Studer (2021). Se busca medir cuánta calidad obtenida por la tipología sobrepasa la que habría sido obtenida para datos sin una estructura de conglomerados. El criterio Max T obtiene los máximos puntajes para las trayectorias que asumen estructuras aleatorias sobre las que comparar la solución de conglomerados obtenida.@studer_validating_2021

Código
categories_pam_om4_q<-attr(States_Wide.seq_quarter_t_prim_adm_cens, "labels")
new_labels <- categories_pam_om4_q
new_labels[which(categories_pam_om4_q == "Otras causas")] <- "Otras\ncausas"
#new_labels[which(categories == "Consumo\nde sustancias")] <- "Consumo de\nsustancias"


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
cat("(==============================================================)\n")
(==============================================================)
Código
cat("Hacemos clasificación de pertenencia cluster a las soluciones candidatas y añadimos etiquetas\n")
Hacemos clasificación de pertenencia cluster a las soluciones candidatas y añadimos etiquetas
Código
ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4 <-
  factor(pamRange_quarter_om$clustering$cluster4,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster4)), "name")),
         labels= c("6623, Un trimestre, TSM(4)", "6612, Un trimestre, TUS(3)", "6522, Un semestre TSM(1)", "6574, Comorbilidad un trimestre(2)"))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4_2 <-
  factor(pamRange_quarter_om2$clustering$cluster4,levels=rev(attr( sort(table(pamRange_quarter_om2$clustering$cluster4)), "name")),
         labels= c("1, Un trimestre, TSM(1)", "15, Un trimestre, TUS(2)", "32, Un semestre TSM(4)", "49, Comorbilidad un trimestre(3)"))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om6 <-
  #pamRange_quarter_om$clustering$cluster6
  factor(pamRange_quarter_om$clustering$cluster6,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster6)), "name")),
         labels= c("6623, Un trimestre, TSM(5)", 
                   "6612, Un trimestre, TUS(4)", 
                   "6522, Un semestre TSM(2)", 
                   "6624, TSM, 1 año después, otras causas(6)",
                   "6574, Comorbilidad un trimestre(3)", 
                   "6268, TSM, 1 año después, TSM(1)"
         ))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om2_2 <-
  factor(pamRange_quarter_om2$clustering$cluster2,levels=rev(attr( sort(table(pamRange_quarter_om2$clustering$cluster2)), "name")), labels= c("1, Un trimestre, TSM(1)", "15, Un trimestre, TUS(2)"))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om3 <-
  factor(pamRange_quarter_om$clustering$cluster3,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster3)), "name")), labels= c("6623, Un trimestre, TSM(3)", "6612, Un trimestre, TUS(2)", "6522, Un semestre TSM(1)"))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om2 <-
  factor(pamRange_quarter_om$clustering$cluster2,levels=rev(attr( sort(table(pamRange_quarter_om$clustering$cluster2)), "name")), labels= c("6623, Un trimestre, TSM(2)", "6612, Un trimestre, TUS(1)"))

ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_hc_om2 <-
  factor(om_dist_quarter_c$clustering$cluster2,levels=rev(attr( sort(table(om_dist_quarter_c$clustering$cluster2)), "name")), labels= c("1, Un trimestre, TSM(1)", "2, Un trimestre, TUS(2)"))


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
cat("(==============================================================)\n")
(==============================================================)
Código
cat("Creamos valores ASW para las soluciones candidatas\n")
Creamos valores ASW para las soluciones candidatas
Código
# Creamos un vector con las columnas llenando con NA si faltan valores
# 
sil_pam_om_clus6_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        pamRange_quarter_om$clustering$cluster6, measure="ASW")

sil_pam_om_clus4_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        pamRange_quarter_om$clustering$cluster4, measure="ASW")

sil_pam_om_clus3_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        pamRange_quarter_om$clustering$cluster3, measure="ASW")

sil_pam_om_clus2_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        pamRange_quarter_om$clustering$cluster2, measure="ASW")

sil_hc_om_clus2_q <- wcSilhouetteObs(as.dist(dist_quarter_om), 
        om_dist_quarter_c$clustering$cluster4, measure="ASW")


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#

Tiempo que demora esta sección: 0.1 minutos

Código
cat("Visualizamos las soluciones\n")
seq_plot_pam_om4_q <- ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om4,
                                 facet_ncol=2, facet_nrow=2, sortv=sil_pam_om_clus4_q) +
  theme(legend.position = "none")+
  labs(x="Trimestres", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om4_q
Visualizamos las soluciones
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.2 minutos

Código
seq_plot_pam_om6_q <- ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om6,
                                 facet_ncol=2, facet_nrow=3, sortv=sil_pam_om_clus6_q) +
  theme(legend.position = "none")+
  labs(x="Trimestres", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om6_q
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.2 minutos

Código
seq_plot_pam_om3_q <- ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om3,
                                 facet_ncol=2, facet_nrow=2, sortv= sil_pam_om_clus3_q) +
  theme(legend.position = "none")+
  labs(x="Trimestres", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om3_q
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.2 minutos

Código
seq_plot_pam_om2_q <- ggseqiplot(States_Wide.seq_quarter_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_quarter_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om2,
                                 facet_ncol=2, facet_nrow=1, sortv= sil_pam_om_clus2_q) +
  theme(legend.position = "none")+
  labs(x="Trimestres", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om2_q 
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.2 minutos

La solución que obtuvo mejores ínices de ajuste ASW fue la de 6 conglomerados, mediante el algoritmo PAM y emparejamiento óptimo (OM). No obstante, los conglomerados 6624, TSM, 1 año después, otras causas y 6268, TSM, 1 año después, TSM, obtuvieron valores ASW negativos, por lo que dicha solución se descarta como alternativa. Por tanto, la solución que sigue en términos de valores ASW más altos es la de 4 conglomerados obtenidos mediante el algoritmo PAM y mediante emparejamiento óptimo (OM), con 0,58 vs. en ASW vs. 0,59 de la solución de 6 conglomerados. Las soluciones que le siguen presentan valores de 0,55 en ASW. La solución de 3 conglomerados distingue entre primer ingreso por TSM, TUS y una estadía de un semestre por TSM, pero la trayectoria de estadía por comorbilidad no emerge. Las soluciones de 2 conglomerados obtenidas mediante el algoritmo jerárquico fueron similares que las obtenidas mediante PAM, diferenciando por el motivo de ingreso entre ingresos por TSM y TUS.

Código
# results: hide
# fig.show: hide

opar <- par(no.readonly = TRUE)

#par(mfrow = c(2, 2)) # 2 filas, 2 columnas

#https://sequenceanalysis.org/2023/10/19/validating-sequence-analysis-typologies-using-parametric-bootstrap/

cbind.data.frame(
  algo= c(rep("HAC OM",4), rep("PAM OM", 10)),
  type= c(rep("Duración y Secuencia",2),rep("Secuencia",2),rep("Duración y Secuencia",5),rep("Secuencia",5)),
  conglomerados= c(rep(c("2", "MaxT 95%"),2), rep(c("4", "3", "2", "6", "MaxT 95%"),2)), rbind.data.frame(hac_om_quarter_null_comb_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], hac_om_quarter_null_seq_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], pam_om_quarter_null_comb_print$results_df[c(3,2,1,5,16),c("ASW", "HG", "PBC", "HC")], pam_om_quarter_null_seq_print$results_df[c(3,2,1,5,16),c("ASW", "HG", "PBC", "HC")]))|> 
    `rownames<-`(NULL) |>
  (\(df) {
    rio::export(df, "_output/sol_conglomerados_tab_validacion_quarter_25.xlsx")            
    knitr::kable(df, "markdown", caption = "Validación CQIs conglomerados (trimestre)")
  })() 
Validación CQIs conglomerados (trimestre)
algo type conglomerados ASW HG PBC HC
HAC OM Duración y Secuencia 2 0.54 0.55 0.36 0.3
HAC OM Duración y Secuencia MaxT 95% [0.44; 0.54] [0.93; 0.96] [0.64; 0.74] [0.19; 0.28]
HAC OM Secuencia 2 0.54 0.55 0.36 0.3
HAC OM Secuencia MaxT 95% [0.24; 0.5] [0.57; 0.74] [0.29; 0.54] [0.25; 0.47]
PAM OM Duración y Secuencia 4 0.58 0.66 0.49 0.2
PAM OM Duración y Secuencia 3 0.55 0.62 0.44 0.24
PAM OM Duración y Secuencia 2 0.55 0.54 0.33 0.34
PAM OM Duración y Secuencia 6 0.59 0.77 0.59 0.1
PAM OM Duración y Secuencia MaxT 95% [0.55; 0.57] [0.94; 0.95] [0.74; 0.75] [0.17; 0.18]
PAM OM Secuencia 4 0.58 0.66 0.49 0.2
PAM OM Secuencia 3 0.55 0.62 0.44 0.24
PAM OM Secuencia 2 0.55 0.54 0.33 0.34
PAM OM Secuencia 6 0.59 0.77 0.59 0.1
PAM OM Secuencia MaxT 95% [0.35; 0.42] [0.68; 0.73] [0.38; 0.42] [0.26; 0.29]

Tiempo que demora esta sección: 0 minutos

Se descartó la solución de 2 conglomerados por ser demasiado simple y, por lo tanto, carecer de valor explicativo en relación con los estados discretos de interés (a saber, las causas de hospitalización). En contraste con una estructura de trayectoria de duración y secuencia aleatoria, los valores obtenidos en los índices Gamma de Hubbert (HG) y Correlación Punto-Biserial (PBC) se encuentran dentro del intervalo esperado para la solución de 7 conglomerados, mientras que para la solución de 4 conglomerados, el índice C de Hubbert también se encuentra dentro de ese intervalo sumado a los otros. Esto significa que sólo el ASW de la solución de 4 conglomerados es mayor que lo esperado. Ahora, en comparación a una estructura de trayectorias aleatoria en términos secuencias, ambas soluciones tienen valores de ASW, HC y PBC superiores al esperable, mientras que en el caso del índice HG sólo es superior al esperable para la solución de 7 conglomerados.

Si observamos la tabla anterior, podemos notar que la solución otbenida mediante el algoritmo jerárquico (HAC) y emparejamiento óptimo (OM) con 2 conglomerados, obtuvo valores de ASW, HG, PBC y HC acorde a los esperados para una estructura de trayectorias aleatorias en términos de duración y secuencia en los índices ASW. Para los índices HG y PBC obtuvo valores más bajos que los esperados, mientras que para el índice HC obtuvo un valor más alto. Si observamos los valores esperados para uan estructura de secuencia aleatoria, la solución de 2 conglomerados obtuvo valores de ASW superiores a los esperados, pero inferiores a los esperados en el índice HG, y dentro de lo esperado en los índices PBC y HC.

En el caso de la solución de 6 conglomerados vs. una estructura aleatoria en términos de duración y secuencia, obtuvo valores ASW superiores a los esperados y más bajos en HC, aunque bajo lo esperado en los índices HG y PBC. Posteriormente, comparándolo con seuencias aleatorias en términos de secuencia, la solución de 6 conglomerados obtuvo valores de ASW, HG, PBC y superiores a los esperados y un índice HC más que para una estructura de trayectorias aleatorias.

Para las soluciones de 2 y 3 conglomerados vs. una estructura de duración y secuencia aleatorias, los valores ASW se encontraban dentro de lo esperado, mientras que los valores de HG, PBC y HC eran inferiores a lo esperado. En el caso de las soluciones de 2 y 3 conglomerados vs. una estructura de secuencia aleatoria, los valores de ASW fueron superiores al esperado e inferiores al esperado en el índice HG para ambas soluciones. No obstante, los valores PBC fueron superiores y los valores HC fueron inferiores para la solución de 3 conglomerados.

Para la solución de 4 conglomerados vs una estructura de secuencia y duración aleatorias, los valores ASW fueron superiores y los HC inferiores al esperado, mientras que los valores HG y PBC fueron inferiores al esperado. Al compararse con una estructura de secuencia aleatoria, los valores ASW y PBC fueron superiores y el valor HC inferiores al esperado, aunque el valor en el índice HG fue más bajo que el esperado.

A continuación se muestra con más detalle el resultado de pruebas de validación mediante bootstraps de la solución obtenida con el algoritmo PAM y emparejamiento óptimo.

Código
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob <- save_base_plot_as_grob(pam_om_quarter_null_comb_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_comb <- plot_grid(
  asw_grob, hc_grob, hg_grob, pbc_grob,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_comb, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Código
ggsave("_figs/pam_om_quarter_comb_qci_25.png", final_plot_comb, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

Código
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob <- save_base_plot_as_grob(pam_om_quarter_null_seq_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_seq <- plot_grid(
  asw_grob, hc_grob, hg_grob, pbc_grob,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_seq, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias aleatorias

Indicadores de calidad vs. bootstrap con secuencias aleatorias

Código
ggsave("_figs/pam_om_quarter_seq_qci_25.png", final_plot_seq, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

0.c.2. Mensual

Código
perm_mes <- new.env()
options(width = 1e4) #para ampliar la vista del capture output
load("_perm/null_ssa_hc_month_om_comb_20250319.Rda", envir = perm_mes) 
hac_om_month_null_comb_stats<-perm_mes$om_month_null_comb$stats
hac_om_month_null_comb_print<-print.seqnullcqi.powder(perm_mes$om_month_null_comb)
plot(perm_mes$om_month_null_comb, "ASW")
hac_om_month_null_comb_plot_asw <- recordPlot()
plot(perm_mes$om_month_null_comb, "HC")
hac_om_month_null_comb_plot_hc <- recordPlot()
plot(perm_mes$om_month_null_comb, "HG")
hac_om_month_null_comb_plot_hg <- recordPlot()
plot(perm_mes$om_month_null_comb, "PBC")
hac_om_month_null_comb_plot_pbc <- recordPlot()

plot(perm_mes$om_month_null_comb, "ASW", type="density")
hac_om_month_null_comb_plot_dens_asw <- recordPlot()
plot(perm_mes$om_month_null_comb, "HC", type="density")
hac_om_month_null_comb_plot_dens_hc <- recordPlot()
plot(perm_mes$om_month_null_comb, "HG", type="density")
hac_om_month_null_comb_plot_dens_hg <- recordPlot()
plot(perm_mes$om_month_null_comb, "PBC", type="density")
hac_om_month_null_comb_plot_dens_pbc <- recordPlot()

rm(om_month_null_comb, envir = perm_mes)

load("_perm/null_ssa_hc_month_om_seq_20250319.Rda", envir = perm_mes) 
hac_om_month_null_seq_stats<-perm_mes$om_month_null_seq$stats
hac_om_month_null_seq_print<-print.seqnullcqi.powder(perm_mes$om_month_null_seq)
plot(perm_mes$om_month_null_seq, "ASW")
hac_om_month_null_seq_plot_asw <- recordPlot()
plot(perm_mes$om_month_null_seq, "HC")
hac_om_month_null_seq_plot_hc <- recordPlot()
plot(perm_mes$om_month_null_seq, "HG")
hac_om_month_null_seq_plot_hg <- recordPlot()
plot(perm_mes$om_month_null_seq, "PBC")
hac_om_month_null_seq_plot_pbc <- recordPlot()

plot(perm_mes$om_month_null_seq, "ASW", type="density")
hac_om_month_null_seq_plot_dens_asw <- recordPlot()
plot(perm_mes$om_month_null_seq, "HC", type="density")
hac_om_month_null_seq_plot_dens_hc <- recordPlot()
plot(perm_mes$om_month_null_seq, "HG", type="density")
hac_om_month_null_seq_plot_dens_hg <- recordPlot()
plot(perm_mes$om_month_null_seq, "PBC", type="density")
hac_om_month_null_seq_plot_dens_pbc <- recordPlot()

rm(om_month_null_seq, envir = perm_mes)

load("_perm/null_ssa_hc_month_lcs_comb_20250319.Rda", envir = perm_mes)
hac_lcs_month_null_comb_stats<-perm_mes$lcs_month_null_comb$stats
hac_lcs_month_null_comb_print<-print.seqnullcqi.powder(perm_mes$lcs_month_null_comb)
plot(perm_mes$lcs_month_null_comb, "ASW")
hac_lcs_month_null_comb_plot_asw <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "HC")
hac_lcs_month_null_comb_plot_hc <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "HG")
hac_lcs_month_null_comb_plot_hg <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "PBC")
hac_lcs_month_null_comb_plot_pbc <- recordPlot()

plot(perm_mes$lcs_month_null_comb, "ASW", type="density")
hac_lcs_month_null_comb_plot_dens_asw <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "HC", type="density")
hac_lcs_month_null_comb_plot_dens_hc <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "HG", type="density")
hac_lcs_month_null_comb_plot_dens_hg <- recordPlot()
plot(perm_mes$lcs_month_null_comb, "PBC", type="density")
hac_lcs_month_null_comb_plot_dens_pbc <- recordPlot()

rm(lcs_month_null_comb, envir = perm_mes)

load("_perm/null_ssa_hc_month_lcs_seq_20250319.Rda", envir = perm_mes)
hac_lcs_month_null_seq_stats<-perm_mes$lcs_month_null_seq$stats
hac_lcs_month_null_seq_print<-print.seqnullcqi.powder(perm_mes$lcs_month_null_seq)
plot(perm_mes$lcs_month_null_seq, "ASW")
hac_lcs_month_null_seq_plot_asw <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "HC")
hac_lcs_month_null_seq_plot_hc <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "HG")
hac_lcs_month_null_seq_plot_hg <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "PBC")
hac_lcs_month_null_seq_plot_pbc <- recordPlot()

plot(perm_mes$lcs_month_null_seq, "ASW", type="density")
hac_lcs_month_null_seq_plot_dens_asw <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "HC", type="density")
hac_lcs_month_null_seq_plot_dens_hc <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "HG", type="density")
hac_lcs_month_null_seq_plot_dens_hg <- recordPlot()
plot(perm_mes$lcs_month_null_seq, "PBC", type="density")
hac_lcs_month_null_seq_plot_dens_pbc <- recordPlot()

rm(lcs_month_null_seq, envir = perm_mes)

load("_perm/null_ssa_pam_month_om_comb_20250319.Rda", envir = perm_mes)
pam_om_month_null_comb_stats<-perm_mes$pam_om_month_null_comb$stats
pam_om_month_null_comb_print<-print.seqnullcqi.powder(perm_mes$pam_om_month_null_comb)
plot(perm_mes$pam_om_month_null_comb, "ASW")
pam_om_month_null_comb_plot_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "HC")
pam_om_month_null_comb_plot_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "HG")
pam_om_month_null_comb_plot_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "PBC")
pam_om_month_null_comb_plot_pbc <- recordPlot()

plot(perm_mes$pam_om_month_null_comb, "ASW", type="density")
pam_om_month_null_comb_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "HC", type="density")
pam_om_month_null_comb_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "HG", type="density")
pam_om_month_null_comb_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_comb, "PBC", type="density")
pam_om_month_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_comb, envir = perm_mes)

load("_perm/null_ssa_pam_month_om_seq_20250319.Rda", envir = perm_mes)
pam_om_month_null_seq_stats<-perm_mes$pam_om_month_null_seq$stats
pam_om_month_null_seq_print<-print.seqnullcqi.powder(perm_mes$pam_om_month_null_seq)
plot(perm_mes$pam_om_month_null_seq, "ASW")
pam_om_month_null_seq_plot_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "HC")
pam_om_month_null_seq_plot_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "HG")
pam_om_month_null_seq_plot_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "PBC")
pam_om_month_null_seq_plot_pbc <- recordPlot()

plot(perm_mes$pam_om_month_null_seq, "ASW", type="density")
pam_om_month_null_seq_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "HC", type="density")
pam_om_month_null_seq_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "HG", type="density")
pam_om_month_null_seq_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_seq, "PBC", type="density")
pam_om_month_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_seq, envir = perm_mes)

load("_perm/null_ssa_pam_month_lcs_comb_20250319.Rda", envir = perm_mes) 
pam_lcs_month_null_comb_stats<-perm_mes$pam_lcs_month_null_comb$stats
pam_lcs_month_null_comb_print<-print.seqnullcqi.powder(perm_mes$pam_lcs_month_null_comb)
plot(perm_mes$pam_lcs_month_null_comb, "ASW")
pam_lcs_month_null_comb_plot_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "HC")
pam_lcs_month_null_comb_plot_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "HG")
pam_lcs_month_null_comb_plot_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "PBC")
pam_lcs_month_null_comb_plot_pbc <- recordPlot()

plot(perm_mes$pam_lcs_month_null_comb, "ASW", type="density")
pam_lcs_month_null_comb_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "HC", type="density")
pam_lcs_month_null_comb_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "HG", type="density")
pam_lcs_month_null_comb_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb, "PBC", type="density")
pam_lcs_month_null_comb_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_comb, envir = perm_mes)

load("_perm/null_ssa_pam_month_lcs_seq_20250319.Rda", envir = perm_mes)
pam_lcs_month_null_seq_stats<-perm_mes$pam_lcs_month_null_seq$stats
pam_lcs_month_null_seq_print<-print.seqnullcqi.powder(perm_mes$pam_lcs_month_null_seq)
plot(perm_mes$pam_lcs_month_null_seq, "ASW")
pam_lcs_month_null_seq_plot_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "HC")
pam_lcs_month_null_seq_plot_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "HG")
pam_lcs_month_null_seq_plot_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "PBC")
pam_lcs_month_null_seq_plot_pbc <- recordPlot()

plot(perm_mes$pam_lcs_month_null_seq, "ASW", type="density")
pam_lcs_month_null_seq_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "HC", type="density")
pam_lcs_month_null_seq_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "HG", type="density")
pam_lcs_month_null_seq_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq, "PBC", type="density")
pam_lcs_month_null_seq_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_seq, envir = perm_mes)

load("_perm/null_ssa_pam_om_month_null_comb2_20250319.Rda", envir = perm_mes) #no está
pam_om_month_null_comb2_stats<-perm_mes$pam_om_month_null_comb2$stats
pam_om_month_null_comb2_print<-print.seqnullcqi.powder(perm_mes$pam_om_month_null_comb2)
plot(perm_mes$pam_om_month_null_comb2, "ASW")
pam_om_month_null_comb2_plot_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "HC")
pam_om_month_null_comb2_plot_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "HG")
pam_om_month_null_comb2_plot_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "PBC")
pam_om_month_null_comb2_plot_pbc <- recordPlot()

plot(perm_mes$pam_om_month_null_comb2, "ASW", type="density")
pam_om_month_null_comb2_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "HC", type="density")
pam_om_month_null_comb2_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "HG", type="density")
pam_om_month_null_comb2_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_comb2, "PBC", type="density")
pam_om_month_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_comb2, envir = perm_mes)

load("_perm/null_ssa_pam_om_month_null_seq2_20250319.Rda", envir = perm_mes) #no está
pam_om_month_null_seq2_stats<-perm_mes$pam_om_month_null_seq2$stats
pam_om_month_null_seq2_print<-print.seqnullcqi.powder(perm_mes$pam_om_month_null_seq2)
plot(perm_mes$pam_om_month_null_seq2, "ASW")
pam_om_month_null_seq2_plot_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "HC")
pam_om_month_null_seq2_plot_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "HG")
pam_om_month_null_seq2_plot_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "PBC")
pam_om_month_null_seq2_plot_pbc <- recordPlot()

plot(perm_mes$pam_om_month_null_seq2, "ASW", type="density")
pam_om_month_null_seq2_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "HC", type="density")
pam_om_month_null_seq2_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "HG", type="density")
pam_om_month_null_seq2_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_om_month_null_seq2, "PBC", type="density")
pam_om_month_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_om_month_null_seq2, envir = perm_mes)

load("_perm/null_ssa_pam_month_lcs_comb2_20250319.Rda", envir = perm_mes)
pam_lcs_month_null_comb2_stats<-perm_mes$pam_lcs_month_null_comb2$stats
pam_lcs_month_null_comb2_print<-print.seqnullcqi.powder(perm_mes$pam_lcs_month_null_comb2)
plot(perm_mes$pam_lcs_month_null_comb2, "ASW")
pam_lcs_month_null_comb2_plot_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "HC")
pam_lcs_month_null_comb2_plot_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "HG")
pam_lcs_month_null_comb2_plot_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "PBC")
pam_lcs_month_null_comb2_plot_pbc <- recordPlot()

plot(perm_mes$pam_lcs_month_null_comb2, "ASW", type="density")
pam_lcs_month_null_comb2_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "HC", type="density")
pam_lcs_month_null_comb2_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "HG", type="density")
pam_lcs_month_null_comb2_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_comb2, "PBC", type="density")
pam_lcs_month_null_comb2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_comb2, envir = perm_mes)

load("_perm/null_ssa_pam_month_lcs_seq2_20250319.Rda", envir = perm_mes) 
pam_lcs_month_null_seq2_stats<-perm_mes$pam_lcs_month_null_seq2$stats
pam_lcs_month_null_seq2_print<-print.seqnullcqi.powder(perm_mes$pam_lcs_month_null_seq2)
plot(perm_mes$pam_lcs_month_null_seq2, "ASW")
pam_lcs_month_null_seq2_plot_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "HC")
pam_lcs_month_null_seq2_plot_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "HG")
pam_lcs_month_null_seq2_plot_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "PBC")
pam_lcs_month_null_seq2_plot_pbc <- recordPlot()

plot(perm_mes$pam_lcs_month_null_seq2, "ASW", type="density")
pam_lcs_month_null_seq2_plot_dens_asw <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "HC", type="density")
pam_lcs_month_null_seq2_plot_dens_hc <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "HG", type="density")
pam_lcs_month_null_seq2_plot_dens_hg <- recordPlot()
plot(perm_mes$pam_lcs_month_null_seq2, "PBC", type="density")
pam_lcs_month_null_seq2_plot_dens_pbc <- recordPlot()

rm(pam_lcs_month_null_seq2, envir = perm_mes)

options(width = getOption("width"))

rm(perm_mes)
rm(perm_mes_alt)

Tiempo que demora esta sección: 0.1 minutos

Código
cqi_month<-
rbind.data.frame(
cbind.data.frame(algo="hac", type="om", time="month", k=2:15, corr=F, om_dist_month_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="hac", type="lcs", time="month", k=2:15, corr=F, lcs_dist_month_c$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="month", k=2:15, corr=F, pamRange_month_om$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="om", time="month", k=2:15, corr=T, pamRange_month_om2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="month", k=2:15, corr=F, pamRange_month_lcs$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2))),
cbind.data.frame(algo="pam", type="lcs", time="month", k=2:15, corr=T, pamRange_month_lcs2$stats) |> dplyr::mutate(across(PBC:HC,~round(.,2)))
) |> 
  dplyr::select(algo, type, time, k, corr, PBC, ASW, HC, HG, R2, R2sq)

tabs_month_clus_sol<-
rbind.data.frame(
func_tab_range_clus(om_dist_month_c),
func_tab_range_clus(lcs_dist_month_c),
func_tab_range_clus(pamRange_month_om),
func_tab_range_clus(pamRange_month_om2),
func_tab_range_clus(pamRange_month_lcs),
func_tab_range_clus(pamRange_month_lcs2)
)

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

# Inicializamos una lista para almacenar los resultados
resultados_list <- list()
# Definimos un rango para los clusters a evaluar
cluster_range <- 2:15
# Definimos los métodos y sus variables
metodos <- list(
    hac_om = list(data = om_dist_month_c, dist = dist_month_om),
    hac_lcs = list(data = lcs_dist_month_c, dist = dist_month_lcs),
    pam_om0 = list(data = pamRange_month_om, dist = dist_month_om),
    pam_om1 = list(data = pamRange_month_om2, dist = dist_month_om),
    pam_lcs0 = list(data = pamRange_month_lcs, dist = dist_month_lcs),
    pam_lcs1 = list(data = pamRange_month_lcs2, dist = dist_month_lcs)
)
# Número máximo de clusters para definir las columnas
max_clusters <- max(cluster_range)
# Iteramos sobre cada método
for (metodo in names(metodos)) {
    # Creamos un data frame temporal para cada método
    metodo_result <- data.frame()
    # Iteramos sobre cada cluster en el rango
    for (cluster in cluster_range) {
        # Construimos el nombre del cluster dinámicamente
        cluster_name <- paste0("cluster", cluster)
        # Intentamos calcular los valores de silhouette
        silhouette_values <- tryCatch(
            round(summary(silhouette(as.integer(metodos[[metodo]]$data$clustering[[cluster_name]]), as.dist(metodos[[metodo]]$dist)))$clus.avg.widths[attr(rev(sort(table(metodos[[metodo]]$data$clustering[[cluster_name]]))),"names")], 2),
            error = function(e) rep(NA, cluster)
        )
        # Creamos un vector con las columnas llenando con NA si faltan valores
        silhouette_full <- c(silhouette_values, rep(NA, max_clusters - length(silhouette_values)))
        # Creamos un data frame temporal con los resultados para este cluster
        cluster_result <- data.frame(
            Metodo = metodo,
            Cluster = cluster,
            t(silhouette_full) # Transponemos los valores para que cada uno sea una columna
        )
        # Nombramos dinámicamente las columnas de silhouette
        colnames(cluster_result)[3:(3 + max_clusters - 1)] <- paste0("asw", 1:max_clusters)
        # Añadimos el resultado del cluster al data frame del método
        metodo_result <- rbind(metodo_result, cluster_result)
    }
    # Agregamos los resultados del método a la lista general
    resultados_list[[metodo]] <- metodo_result
}
# Combinamos todos los resultados en un único data frame
avs_por_cluster_month <- do.call(rbind, resultados_list)
# Ordenamos por Método y Cluster
avs_por_cluster_month <- avs_por_cluster_month[order(avs_por_cluster_month$Metodo, avs_por_cluster_month$Cluster), ]


bind_cols(cqi_month, tabs_month_clus_sol)|>
  dplyr::mutate(corr= dplyr::case_when(corr==TRUE & algo!="hac"~"1",corr==FALSE & algo!="hac"~"0",T~""), key= paste0(algo,"_",type,corr,"_",k))|> 
  left_join(dplyr::mutate(avs_por_cluster_month, key=paste0(Metodo,"_",Cluster)), by="key")|> 
  dplyr::select(-Metodo, -Cluster) |> 
            `rownames<-`(NULL) |>
  dplyr::mutate(calc= round(PBC*(1/HC)*HG,2)) |> 
  dplyr::arrange(desc(ASW)) |>
  dplyr::select(c("algo", "type", "time", "k", "corr", "PBC", "ASW", "HC", "HG", "R2", "R2sq", "calc", paste0("X",1:15), paste0("asw",1:15)))|> 
  (\(df) {
    assign("asw_month_qci", dplyr::select(df, -"time"), envir = .GlobalEnv)
    rio::export(df, "_output/sol_conglomerados_tab_month_25.xlsx")            
    knitr::kable(df, "markdown", caption = "CQIs y frecuencias en conglomerados (mensual)")
  })()
CQIs y frecuencias en conglomerados (mensual)
algo type time k corr PBC ASW HC HG R2 R2sq calc X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12 X13 X14 X15 asw1 asw2 asw3 asw4 asw5 asw6 asw7 asw8 asw9 asw10 asw11 asw12 asw13 asw14 asw15
hac om month 2 0.49 0.86 0.15 0.99 0.03 0.12 3.23 6598 28 0.87 0.06
hac lcs month 2 0.58 0.63 0.10 0.91 0.15 0.22 5.28 5740 886 0.76 -0.21
hac lcs month 3 0.60 0.61 0.09 0.91 0.18 0.34 6.07 5740 840 46 0.73 -0.16 -0.07
pam om month 15 0 0.44 0.45 0.11 0.75 0.39 0.50 3.00 4208 749 585 197 157 117 113 102 93 87 85 67 44 16 6 0.57 0.47 0.33 0.19 0.17 0.12 -0.06 -0.14 -0.07 -0.11 -0.15 -0.18 0.06 0.09 0.14
pam om month 14 1 0.44 0.45 0.11 0.74 0.38 0.49 2.96 4208 749 585 197 168 144 116 103 93 88 78 73 18 6 0.57 0.47 0.33 0.19 0.19 -0.03 -0.06 -0.16 -0.07 -0.11 -0.12 -0.19 0.10 0.15
pam om month 15 1 0.44 0.45 0.10 0.76 0.39 0.50 3.34 4127 749 585 197 168 144 114 102 93 87 85 84 67 18 6 0.60 0.46 0.31 0.18 0.19 -0.04 -0.06 -0.15 -0.09 -0.12 -0.15 -0.15 -0.19 0.10 0.15
pam om month 8 0 0.42 0.44 0.15 0.68 0.33 0.37 1.90 4477 753 620 235 198 140 106 97 0.52 0.48 0.29 0.10 0.22 -0.20 -0.15 -0.25
pam om month 9 0 0.41 0.44 0.16 0.68 0.34 0.42 1.74 4450 749 622 198 180 148 135 123 21 0.53 0.49 0.27 0.23 0.02 0.05 -0.20 -0.09 0.02
pam om month 10 0 0.42 0.44 0.14 0.70 0.35 0.44 2.10 4408 750 605 197 178 148 119 119 89 13 0.54 0.48 0.30 0.22 0.10 -0.02 -0.06 -0.17 -0.22 0.14
pam om month 11 0 0.43 0.44 0.13 0.71 0.36 0.45 2.35 4319 750 605 197 176 148 118 118 95 87 13 0.56 0.47 0.29 0.21 0.13 -0.03 -0.06 -0.17 -0.11 -0.22 0.14
pam om month 12 0 0.43 0.44 0.12 0.72 0.37 0.46 2.58 4294 749 585 197 170 148 114 103 93 87 73 13 0.55 0.48 0.34 0.21 0.15 -0.05 -0.05 -0.14 -0.05 -0.18 -0.23 0.14
pam om month 13 0 0.43 0.44 0.12 0.72 0.37 0.47 2.58 4294 749 585 197 157 128 115 102 93 86 71 38 11 0.55 0.48 0.34 0.21 0.20 0.11 -0.05 -0.12 -0.05 -0.18 -0.22 -0.06 0.13
pam om month 14 0 0.43 0.44 0.12 0.72 0.38 0.49 2.58 4294 749 585 197 157 117 113 103 93 85 67 44 16 6 0.55 0.48 0.34 0.21 0.17 0.12 -0.05 -0.14 -0.05 -0.14 -0.18 0.06 0.09 0.14
pam om month 7 1 0.39 0.44 0.17 0.64 0.31 0.40 1.47 4539 754 729 239 198 145 22 0.52 0.49 0.24 -0.08 0.24 -0.20 0.03
pam om month 8 1 0.42 0.44 0.15 0.68 0.33 0.37 1.90 4477 753 620 235 198 140 106 97 0.52 0.48 0.29 0.10 0.22 -0.20 -0.15 -0.25
pam om month 9 1 0.42 0.44 0.15 0.68 0.34 0.43 1.90 4477 753 620 235 198 139 99 93 12 0.52 0.48 0.29 0.10 0.22 -0.19 -0.02 -0.22 0.15
pam om month 10 1 0.42 0.44 0.14 0.70 0.35 0.44 2.10 4408 750 605 197 181 148 119 116 89 13 0.54 0.48 0.30 0.22 0.07 -0.01 -0.17 -0.04 -0.22 0.14
pam om month 11 1 0.43 0.44 0.13 0.71 0.36 0.45 2.35 4319 750 605 197 179 148 118 115 95 87 13 0.56 0.47 0.29 0.21 0.10 -0.02 -0.17 -0.04 -0.11 -0.22 0.14
pam om month 12 1 0.43 0.44 0.12 0.72 0.37 0.46 2.58 4294 749 585 197 169 148 112 111 93 78 77 13 0.55 0.48 0.34 0.21 0.19 -0.07 -0.15 -0.05 -0.05 -0.22 -0.18 0.14
pam om month 13 1 0.43 0.44 0.12 0.72 0.37 0.49 2.58 4294 749 585 197 169 144 112 111 93 75 73 18 6 0.55 0.48 0.34 0.21 0.19 -0.03 -0.15 -0.05 -0.05 -0.12 -0.19 0.10 0.15
hac om month 10 0.39 0.43 0.17 0.64 0.29 0.42 1.47 4312 995 743 314 186 28 25 18 3 2 0.60 -0.17 0.51 -0.16 0.35 -0.17 -0.02 -0.07 0.49 0.75
hac om month 11 0.40 0.43 0.15 0.66 0.31 0.45 1.76 4312 743 728 314 267 186 28 25 18 3 2 0.57 0.51 0.08 -0.19 -0.28 0.34 -0.18 -0.03 -0.09 0.49 0.75
hac om month 12 0.40 0.43 0.15 0.66 0.32 0.46 1.76 4312 743 728 314 267 186 28 18 15 10 3 2 0.57 0.51 0.08 -0.19 -0.28 0.34 -0.18 -0.09 -0.04 0.39 0.44 0.75
pam om month 5 0 0.35 0.43 0.22 0.59 0.27 0.29 0.94 4645 760 759 256 206 0.50 0.20 0.46 -0.18 0.21
pam om month 6 0 0.39 0.43 0.18 0.63 0.30 0.35 1.36 4590 754 724 229 205 124 0.50 0.48 0.26 -0.06 0.21 -0.25
pam om month 7 0 0.41 0.43 0.16 0.67 0.32 0.36 1.72 4492 751 705 218 203 140 117 0.52 0.47 0.29 -0.06 0.21 -0.12 -0.26
pam om month 6 1 0.39 0.43 0.18 0.63 0.30 0.34 1.36 4590 754 633 320 205 124 0.50 0.48 0.26 -0.03 0.21 -0.25
pam lcs month 2 0 0.25 0.43 0.39 0.48 0.10 0.12 0.31 5646 980 0.52 -0.05
pam lcs month 2 1 0.25 0.43 0.39 0.48 0.10 0.12 0.31 5646 980 0.52 -0.05
hac om month 9 0.36 0.42 0.19 0.62 0.28 0.40 1.17 4340 995 743 314 186 25 18 3 2 0.58 -0.16 0.52 -0.15 0.36 -0.02 -0.07 0.49 0.75
hac om month 13 0.40 0.42 0.15 0.67 0.33 0.48 1.79 4312 743 691 314 267 186 37 28 18 15 10 3 2 0.53 0.51 0.22 -0.20 -0.29 0.34 -0.11 -0.18 -0.09 -0.08 0.39 0.44 0.75
hac om month 14 0.40 0.42 0.15 0.67 0.34 0.49 1.79 4312 743 691 269 267 186 45 37 28 18 15 10 3 2 0.53 0.51 0.22 -0.18 -0.29 0.34 0.24 -0.12 -0.18 -0.10 -0.08 0.32 0.44 0.75
hac om month 15 0.40 0.42 0.15 0.67 0.34 0.50 1.79 4312 743 691 269 267 186 45 37 28 15 15 10 3 3 2 0.53 0.51 0.22 -0.18 -0.29 0.34 0.24 -0.12 -0.18 -0.04 -0.08 0.32 0.43 0.19 0.75
hac lcs month 15 0.37 0.42 0.05 0.84 0.45 0.59 6.22 2786 1412 726 641 435 176 175 145 60 24 16 13 12 3 2 1.00 -0.22 0.28 0.38 -0.23 -0.16 0.12 0.00 -0.19 -0.02 -0.01 0.07 0.33 0.46 0.75
pam om month 3 0 0.30 0.42 0.28 0.51 0.21 0.21 0.55 4874 987 765 0.50 -0.06 0.47
pam om month 3 1 0.30 0.42 0.28 0.51 0.21 0.21 0.55 4874 987 765 0.50 -0.06 0.47
pam om month 5 1 0.35 0.42 0.22 0.59 0.27 0.29 0.94 4645 759 666 350 206 0.50 0.46 0.19 -0.15 0.21
pam lcs month 10 1 0.42 0.42 0.11 0.78 0.36 0.49 2.98 4269 737 696 252 173 133 128 112 105 21 0.54 0.37 0.30 -0.03 0.20 -0.20 -0.02 0.02 -0.16 0.03
pam lcs month 14 1 0.44 0.42 0.09 0.83 0.40 0.53 4.06 4177 714 573 174 164 148 128 124 104 97 88 60 53 22 0.55 0.43 0.29 0.17 0.48 -0.14 -0.04 -0.18 -0.15 0.04 -0.15 -0.14 -0.14 0.01
pam lcs month 15 1 0.44 0.42 0.08 0.84 0.41 0.54 4.62 4143 701 547 168 162 150 146 119 107 85 84 80 60 52 22 0.55 0.46 0.34 0.20 0.48 -0.26 -0.13 -0.01 -0.11 0.10 -0.15 -0.09 -0.14 -0.16 0.00
hac om month 3 0.25 0.41 0.40 0.42 0.14 0.22 0.26 5667 931 28 0.41 0.39 0.04
hac lcs month 4 0.49 0.41 0.12 0.80 0.26 0.38 3.27 5014 840 726 46 0.50 -0.18 0.47 -0.07
hac lcs month 5 0.49 0.41 0.12 0.80 0.26 0.41 3.27 5014 840 726 31 15 0.50 -0.18 0.47 -0.07 0.21
hac lcs month 6 0.49 0.41 0.12 0.80 0.27 0.44 3.27 5014 816 726 31 24 15 0.50 -0.17 0.47 -0.08 0.02 0.21
pam lcs month 8 0 0.40 0.41 0.14 0.73 0.33 0.46 2.09 4395 749 727 254 184 150 142 25 0.52 0.36 0.22 0.01 0.13 -0.12 -0.18 0.02
pam lcs month 9 0 0.42 0.41 0.13 0.76 0.35 0.48 2.46 4326 749 700 228 182 169 132 116 24 0.53 0.34 0.28 0.04 0.14 -0.10 -0.18 -0.15 0.03
pam lcs month 10 0 0.42 0.41 0.12 0.78 0.36 0.49 2.73 4261 746 693 197 180 171 127 119 108 24 0.54 0.34 0.28 0.06 0.15 -0.12 -0.19 -0.16 0.03 0.03
pam lcs month 11 0 0.42 0.41 0.12 0.78 0.37 0.50 2.73 4278 746 599 180 170 164 128 114 112 111 24 0.53 0.34 0.19 0.15 -0.12 0.51 -0.19 -0.15 0.02 -0.08 0.01
pam lcs month 13 0 0.44 0.41 0.09 0.81 0.39 0.52 3.96 4217 735 578 178 164 164 112 111 101 101 91 49 25 0.54 0.37 0.28 0.14 0.48 -0.10 -0.09 -0.15 0.03 -0.15 -0.15 -0.12 0.00
pam lcs month 15 0 0.44 0.41 0.08 0.83 0.41 0.54 4.56 4161 727 563 190 181 116 109 106 104 91 87 62 60 49 20 0.54 0.40 0.26 -0.11 0.13 -0.16 -0.01 -0.16 0.79 -0.15 0.18 -0.14 -0.06 -0.13 0.00
pam lcs month 8 1 0.42 0.41 0.13 0.76 0.34 0.43 2.46 4342 742 709 261 176 145 137 114 0.53 0.37 0.28 -0.02 0.20 -0.19 -0.03 -0.18
pam lcs month 11 1 0.42 0.41 0.12 0.78 0.37 0.50 2.73 4285 741 602 172 168 152 140 134 116 101 15 0.53 0.35 0.22 0.21 0.48 -0.13 -0.07 -0.20 0.01 -0.15 0.10
pam lcs month 12 1 0.43 0.41 0.11 0.79 0.38 0.51 3.09 4267 739 580 172 164 148 134 128 103 98 71 22 0.52 0.36 0.27 0.19 0.49 -0.14 -0.04 -0.20 0.02 -0.10 -0.18 0.02
pam lcs month 13 1 0.44 0.41 0.09 0.81 0.39 0.52 3.96 4217 732 578 177 167 148 134 109 99 96 92 55 22 0.54 0.37 0.28 0.16 0.47 -0.14 -0.05 -0.15 -0.15 0.04 -0.15 -0.15 0.02
hac om month 8 0.36 0.40 0.19 0.61 0.26 0.38 1.16 4340 995 929 314 25 18 3 2 0.59 -0.15 0.31 -0.14 -0.02 -0.06 0.49 0.77
pam om month 2 0 0.16 0.40 0.49 0.38 0.11 0.10 0.12 5857 769 0.38 0.52
pam om month 4 0 0.32 0.40 0.26 0.55 0.24 0.26 0.68 4837 768 765 256 0.45 0.21 0.46 -0.17
pam om month 2 1 0.16 0.40 0.49 0.38 0.11 0.10 0.12 5857 769 0.38 0.52
pam om month 4 1 0.32 0.40 0.26 0.54 0.24 0.25 0.66 4837 765 674 350 0.45 0.46 0.21 -0.15
pam lcs month 12 0 0.43 0.40 0.11 0.79 0.38 0.51 3.09 4267 744 580 180 165 164 127 112 112 102 48 25 0.52 0.34 0.27 0.14 -0.10 0.49 -0.19 -0.15 -0.09 0.02 -0.13 0.00
pam lcs month 14 0 0.44 0.40 0.09 0.82 0.40 0.53 4.01 4201 735 568 178 171 160 110 104 100 98 91 50 38 22 0.53 0.37 0.25 0.13 -0.08 -0.11 -0.15 0.79 -0.15 0.03 -0.15 -0.12 0.09 -0.03
pam lcs month 7 1 0.40 0.40 0.15 0.73 0.31 0.39 1.95 4395 744 727 258 178 176 148 0.52 0.37 0.22 -0.01 0.18 -0.22 -0.19
pam lcs month 9 1 0.42 0.40 0.13 0.76 0.35 0.43 2.46 4351 745 601 204 176 158 145 133 113 0.51 0.36 0.22 -0.21 0.20 0.53 -0.20 -0.01 -0.19
hac om month 4 0.33 0.39 0.22 0.58 0.22 0.27 0.87 4340 1327 931 28 0.60 -0.24 0.29 0.00
hac om month 5 0.34 0.39 0.21 0.58 0.23 0.30 0.94 4340 1309 931 28 18 0.60 -0.21 0.29 -0.01 -0.04
hac om month 6 0.34 0.39 0.21 0.58 0.23 0.33 0.94 4340 1309 929 28 18 2 0.59 -0.21 0.31 -0.01 -0.04 0.77
hac om month 7 0.34 0.39 0.21 0.58 0.24 0.36 0.94 4340 1309 929 25 18 3 2 0.59 -0.21 0.31 0.01 -0.05 0.49 0.77
hac lcs month 14 0.37 0.39 0.07 0.79 0.43 0.58 4.18 2786 2053 726 435 176 175 145 60 24 16 13 12 3 2 1.00 -0.17 0.28 -0.20 -0.13 0.12 0.12 -0.16 -0.01 -0.01 0.07 0.33 0.46 0.75
pam lcs month 6 0 0.37 0.39 0.18 0.67 0.29 0.36 1.38 4512 753 745 268 185 163 0.48 0.37 0.22 -0.05 0.18 -0.20
pam lcs month 7 0 0.38 0.39 0.16 0.69 0.32 0.41 1.64 4467 753 711 258 181 145 111 0.47 0.36 0.30 -0.01 0.20 -0.03 -0.18
hac lcs month 11 0.37 0.38 0.08 0.76 0.39 0.55 3.52 2961 2053 726 435 236 145 29 24 12 3 2 0.88 -0.12 0.31 -0.19 -0.19 0.12 -0.08 -0.01 0.37 0.47 0.76
hac lcs month 12 0.37 0.38 0.08 0.76 0.40 0.56 3.52 2961 2053 726 435 236 145 24 16 13 12 3 2 0.88 -0.12 0.31 -0.19 -0.19 0.12 -0.01 0.00 0.08 0.33 0.46 0.76
hac lcs month 13 0.37 0.38 0.08 0.76 0.40 0.57 3.52 2961 2053 726 435 176 145 60 24 16 13 12 3 2 0.88 -0.12 0.31 -0.19 -0.13 0.12 -0.16 -0.01 -0.01 0.07 0.33 0.46 0.76
hac lcs month 7 0.34 0.37 0.11 0.71 0.36 0.46 2.19 2961 2053 816 726 31 24 15 0.88 -0.12 -0.20 0.31 -0.08 0.00 0.21
hac lcs month 8 0.34 0.37 0.11 0.71 0.37 0.49 2.19 2961 2053 816 726 31 24 12 3 0.88 -0.12 -0.20 0.31 -0.10 0.00 0.41 0.48
hac lcs month 9 0.34 0.37 0.11 0.71 0.37 0.51 2.19 2961 2053 816 726 29 24 12 3 2 0.88 -0.12 -0.20 0.31 -0.05 0.00 0.40 0.47 0.76
hac lcs month 10 0.36 0.37 0.10 0.74 0.38 0.53 2.66 2961 2053 726 671 145 29 24 12 3 2 0.88 -0.12 0.31 -0.23 0.13 -0.06 -0.01 0.37 0.47 0.76
pam lcs month 5 0 0.36 0.37 0.20 0.64 0.27 0.34 1.15 4697 753 745 268 163 0.43 0.37 0.25 -0.05 -0.19
pam lcs month 4 0 0.32 0.36 0.24 0.58 0.23 0.27 0.77 4790 778 760 298 0.42 0.21 0.35 -0.19
pam lcs month 3 0 0.26 0.34 0.31 0.50 0.18 0.18 0.42 4885 980 761 0.42 -0.09 0.37
pam lcs month 3 1 0.26 0.34 0.31 0.50 0.18 0.18 0.42 4885 980 761 0.42 -0.09 0.37
pam lcs month 4 1 0.34 0.30 0.23 0.59 0.25 0.30 0.87 4803 754 676 393 0.31 0.39 0.47 -0.24
pam lcs month 5 1 0.36 0.29 0.20 0.64 0.28 0.35 1.15 4697 750 624 392 163 0.30 0.38 0.55 -0.16 -0.20
pam lcs month 6 1 0.37 0.25 0.18 0.66 0.30 0.36 1.36 4532 748 536 453 187 170 0.25 0.38 0.71 -0.19 0.14 -0.21

Tiempo que demora esta sección: 0 minutos

Código
frobenius_norm(as.matrix(func_tab_range_clus(pamRange_quarter_lcs)), as.matrix(func_tab_range_clus(pamRange_quarter_lcs2)))

invisible("Frobenius norm: ||A-B||_F=\sqrt{\sum{i,j}(A_{ij}-B_ij)^2}")
invisible("Por ahora lo dejamos pasar, es para comparar matrices y sus diferencias")

Tiempo que demora esta sección: 0 minutos

La mayoría de las soluciones presentaron conglomerados con tamaños muy pequeños (n < 30), lo que limita su generalización y sugiere una estabilidad presumiblemente baja, o bien con valores ASW negativos, lo que añade evidencia a problemas de estabilidad de la solución.

Código
asw_month_qci$label<-with(asw_month_qci, paste0(algo, "_",type, "_", k, "_", ifelse(corr==1,1,ifelse(corr==0,0,0))))
plot(sort(asw_month_qci$ASW, decreasing = TRUE), 
     type = "b", 
     pch = 19, 
     xlab = "", 
     xaxt = "n",
     ylab = "Valor de ASW", 
     main = "", 
     col = "blue")
axis(1, at = 1:length(asw_month_qci$label), labels = asw_month_qci$label, las = 2, cex.axis = 0.60)
Gráfico de codo, ASW con etiquetas soluciones de conglomerados (soluciones de res. mensual)

Gráfico de codo, ASW con etiquetas soluciones de conglomerados (soluciones de res. mensual)

Tiempo que demora esta sección: 0 minutos

Sólo las soluciones de 2 y 3 conglomerados obtuvieron valores ASW en cada conglomerados superiores a 0, es decir, no obtuvieron conglomerados negativos.

Código
categories_hac_om2_m<-attr(States_Wide.seq_month_t_prim_adm_cens, "labels")
new_labels2 <- categories_hac_om2_m
new_labels2[which(categories_hac_om2_m == "Otras causas")] <- "Otras\ncausas"
#new_labels[which(categories == "Consumo\nde sustancias")] <- "Consumo de\nsustancias"


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
cat("(==============================================================)\n")
(==============================================================)
Código
cat("Hacemos clasificación de pertenencia cluster a las soluciones candidatas y añadimos etiquetas\n")
Hacemos clasificación de pertenencia cluster a las soluciones candidatas y añadimos etiquetas
Código
ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_hc_om2 <-
  factor(om_dist_month_c$clustering$cluster2,levels=rev(attr( sort(table(om_dist_month_c$clustering$cluster2)), "name")), labels= c("1, Un trimestre, TSM(1)", "2, Múltiples episodios, TSM(2)"))

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_hc_om3 <-
  factor(om_dist_month_c$clustering$cluster3, levels=rev(attr( sort(table(om_dist_month_c$clustering$cluster3)), "name")), labels= c("1, Un trimestre, TSM(1)", "2, Un trimestre, TUS y Comorbilidad(3)", "3, Múltiples episodios, TSM(2)"))

ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om2 <-
  factor(pamRange_month_om$clustering$cluster2,levels=rev(attr( sort(table(pamRange_month_om$clustering$cluster2)), "name")),
         labels= c("6623, Un trimestre, TSM y Comorbilidad(2)", "6612, Un trimestre TSM(1)"))


#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
cat("(==============================================================)\n")
(==============================================================)
Código
cat("Creamos valores ASW para las soluciones candidatas\n")
Creamos valores ASW para las soluciones candidatas
Código
# Creamos un vector con las columnas llenando con NA si faltan valores
# 
sil_hc_om_clus2_m <- wcSilhouetteObs(as.dist(dist_month_om), 
        om_dist_month_c$clustering$cluster2, measure="ASW")
sil_hc_om_clus3_m <- wcSilhouetteObs(as.dist(dist_month_om), 
        om_dist_month_c$clustering$cluster3, measure="ASW")
sil_pam_om_clus2_m <- wcSilhouetteObs(as.dist(dist_month_om), 
        pamRange_month_om$clustering$cluster2, measure="ASW")

#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:
#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:#:

Tiempo que demora esta sección: 0.1 minutos

Código
cat("(==============================================================)\n")
cat("Visualizamos las soluciones\n")
seq_plot_hc_om2_m <- ggseqiplot(States_Wide.seq_month_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_hc_om2,
                                  #om_dist_month_c$clustering$cluster2,
                                 facet_ncol=2, facet_nrow=1, sortv=sil_hc_om_clus2_m) +
  theme(legend.position = "none")+
  labs(x="Meses", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_hc_om2_m
(==============================================================)
Visualizamos las soluciones
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.4 minutos

Código
seq_plot_hc_om3_m <- ggseqiplot(States_Wide.seq_month_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_hc_om3,
                                 facet_ncol=2, facet_nrow=2, sortv=sil_hc_om_clus3_m) +
  theme(legend.position = "none")+
  labs(x="Meses", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_hc_om3_m
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.4 minutos

Código
seq_plot_pam_om2_m <- ggseqiplot(States_Wide.seq_month_t_prim_adm_cens, 
                                 group= ing_dt_ing_calendar_month_t_desde_primera_adm_dedup_wide2_cens$clus_pam_om2,
                                 facet_ncol=2, facet_nrow=2, sortv=sil_pam_om_clus2_m) +
  theme(legend.position = "none")+
  labs(x="Meses", y="# IDs de usuarios")+
  #guides(fill = guide_legend(nrow = 1))+
  theme(
    panel.spacing = unit(0.1, "lines"),  # Reduce el espaciado entre los paneles
    axis.text.y = element_text(size = 15),           # Tamaño de las etiquetas de los grupos étnicos
    axis.text.x = element_text(size = 15),           # Tamaño de las etiquetas del eje X
    axis.title.x = element_text(size = 15),          # Tamaño del título del eje X
    axis.title.y = element_text(size = 15, margin = margin(r = -10)),#,margin = margin(l = -10)),
    strip.text = element_text(size = 11, margin = margin(b =-15)),
    legend.text = element_text(size = 15),
    legend.spacing.x = unit(0.1, 'cm'),  # Alinea el título de la leyenda hacia la izquierda
    legend.box.margin = margin(t = 0, r = 0, b = 0, l = -50),
    legend.position = "bottom", 
    legend.justification = "left",
    panel.spacing.y = unit(0.5, "lines"),
    strip.placement = "outside",   # Para colocar las tiras fuera de los ejes
    strip.background = element_blank() # Elimina el fondo para que parezca más espacioso
    #legend.key.size = unit(1.5, "lines"),        # Aumenta el tamaño de los símbolos en la leyenda
  )+
  guides(fill = guide_legend(nrow = 1)) +
  scale_fill_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                  "#FFFFFF","#808080","#000000"))+
  scale_color_manual(labels = new_labels, values=c("#E2725B", "#556B2F", "#D2B48C",#"#8B4513",
                                                   "#FFFFFF","#808080","#000000"))
seq_plot_pam_om2_m
Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Trayectorias de hospitalización, orden de sujetos según el primer estado observado y su duración, representando a cada individuo como una línea en el gráfico (observaciones ordenadas de acuerdo a ASW)

Tiempo que demora esta sección: 0.4 minutos

De las solciones de conglomerados que no obtuvieron algún conglomerado con valores ASW negativos, la solución que obtuvo mejores ínices de ajuste ASW fue la de 2 conglomerados, mediante el algoritmo jerárquico y emparejamiento óptimo (OM) con valores ASW 0,86. Sin embargo, la agrupación es muy poco informativa respecto a los motivos (ej., un episodio de cualquier tipo, vs. múltiples episodios). Por otra parte, la agrupación con múltiples episodios está compuesta por menos de 30 observaciones.

La siguiente solución obtuvo índices de ajuste subóptimos (ASW= 0,41), aunque logró distinguir por diagnóstico del episodio hospitalario, aunque persiste un tercer grupo con múltiples episodios con menos de 30 observaciones.

La tercera y cuarta soluciones obtuvieron un índice de ajuste supótimos (ASW=0,40), aunque distinguir entre ingresos con diagnósticos TSM el primer semestre, vs. el primer trimestre por TSM.

A continuación, vemos los índices de calidad de la solución mediante remuestreos bootstrap con al menos 1,000 replicaciones.

Código
# results: hide
# fig.show: hide

opar <- par(no.readonly = TRUE)

#par(mfrow = c(2, 2)) # 2 filas, 2 columnas

#https://sequenceanalysis.org/2023/10/19/validating-sequence-analysis-typologies-using-parametric-bootstrap/

cbind.data.frame(
  algo= c(rep("PAM OM",2)),
  type= c(rep("Duración y secuencia",2),rep("Secuencia",2)),
  conglomerados= c("2","MaxT 95%"), rbind.data.frame(pam_om_month_null_comb_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")], pam_om_month_null_seq_print$results_df[c(1,16),c("ASW", "HG", "PBC", "HC")]))|> 
  (\(df) {
        rio::export(df, "_output/sol_conglomerados_tab_m_validacion_25.xlsx")            
        knitr::kable(df, "markdown", caption = "Validación CQIs conglomerados (mes)")
  })()   
Validación CQIs conglomerados (mes)
algo type conglomerados ASW HG PBC HC
1 PAM OM Duración y secuencia 2 0.4 0.38 0.16 0.49
16 PAM OM Duración y secuencia MaxT 95% [0.59; 0.61] [0.97; 0.98] [0.77; 0.78] [0.15; 0.16]
11 PAM OM Secuencia 2 0.4 0.38 0.16 0.49
161 PAM OM Secuencia MaxT 95% [0.37; 0.39] [0.55; 0.61] [0.31; 0.35] [0.3; 0.32]

Tiempo que demora esta sección: 0 minutos

Sólo los índices ASW mostraron mejores índices de calidad que los esperados para una estructura aleatoria en términos de secuencias, mientras que el resto de los índices se encuentran dentro o por debajo de los rangos esperados. Para el resto de los indicadores, se encuentran por debajo de una estructura de secuencias aleatorias en duración y secuencia.

A continuación se muestra el resultado de pruebas de validación mediante bootstraps.

Código
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob_m <- save_base_plot_as_grob(pam_om_month_null_comb_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_comb_m <- plot_grid(
  asw_grob_m, hc_grob_m, hg_grob_m, pbc_grob_m,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_comb_m, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Indicadores de calidad vs. bootstrap con secuencias y duraciones aleatorias

Código
ggsave("_figs/pam_om_month_comb_qci_25.png", final_plot_comb_m, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos

Código
# results: hide
# fig.show: hide

ratio_plot=5
asw_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_asw, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hc_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_hc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
hg_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_hg, width = 800*ratio_plot, height = 600*ratio_plot, res=500)
pbc_grob_seq_m <- save_base_plot_as_grob(pam_om_month_null_seq_plot_pbc, width = 800*ratio_plot, height = 600*ratio_plot, res=500)

final_plot_m_seq <- plot_grid(
  asw_grob_seq_m, hc_grob_seq_m, hg_grob_seq_m, pbc_grob_seq_m,
  ncol = 2,                    # Número de columnas
  nrow = 2,                    # Número de filas
  rel_widths = c(1, 1),        # Ancho relativo de los gráficos
  rel_heights = c(1, 1),
  labels = c("A", "B", "C", "D"),  # Etiquetas opcionales
  label_size = 15,             # Tamaño de las etiquetas
  align = "v",                 # Alineación vertical de los gráficos
  axis = "tb"                  # Alineación de ejes superior e inferior
)

ggdraw() +
  draw_plot(final_plot_m_seq, x = 0, y = 0.1, width = 1, height = 0.9) +
  draw_text("Área gris: índices de agrupaciones aleatorias; línea negra: índices obtenidos", x = 0.05, y = 0.05, hjust = 0, size = 8, lineheight = .8)
Indicadores de calidad vs. bootstrap con secuencias aleatorias

Indicadores de calidad vs. bootstrap con secuencias aleatorias

Código
ggsave("_figs/pam_om_month_seq_qci_25.png", final_plot_m_seq, width = 12, height = 9, dpi = 600)

Tiempo que demora esta sección: 0 minutos


Información de la sesión

Código
message(paste0("R library: ", Sys.getenv("R_LIBS_USER")))

R library: C:/R/win-library/4.4

Código
message(paste0("Date: ",withr::with_locale(new = c('LC_TIME' = 'C'), code =Sys.time())))

Date: 2025-04-01 12:54:46.039294

Código
message(paste0("Editor context: ", getwd()))

Editor context: H:/Mi unidad/PERSONAL ANDRES/UCH_salud_publica/asignaturas/un_inv_II

Código
cat("quarto version: "); system("quarto --version") 
quarto version: 
[1] 0
Código
save.image("avance25011725_pre_25.RData")

Tiempo que demora esta sección: 0.1 minutos

Código
sesion_info <- devtools::session_info()

Warning in system2(“quarto”, “-V”, stdout = TRUE, env = paste0(“TMPDIR=”, : el comando ejecutado ‘“quarto” TMPDIR=C:/Users/andre/AppData/Local/Temp/RtmpKgNHwT/file5facb79cb0 -V’ tiene el estatus 1

Código
dplyr::select(
  tibble::as_tibble(sesion_info$packages),
  c(package, loadedversion, source)
) |> 
 knitr::kable(caption = "R packages", format = "html",
      col.names = c("Row number", "Package", "Version"),
    row.names = FALSE,
      align = c("c", "l", "r")) |> 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) |> 
  kableExtra::scroll_box(width = "100%", height = "375px")  
R packages
Row number Package Version
abind 1.4-8 CRAN (R 4.4.1)
backports 1.5.0 CRAN (R 4.4.1)
boot 1.3-31 CRAN (R 4.4.1)
broom 1.0.7 CRAN (R 4.4.1)
cachem 1.1.0 CRAN (R 4.4.1)
car 3.1-3 CRAN (R 4.4.1)
carData 3.0-5 CRAN (R 4.4.1)
chisq.posthoc.test 0.1.2 CRAN (R 4.4.1)
cli 3.6.4 CRAN (R 4.4.1)
cluster 2.1.8.1 CRAN (R 4.4.1)
coda 0.19-4.1 CRAN (R 4.4.1)
codetools 0.2-20 CRAN (R 4.4.1)
colorspace 2.1-1 CRAN (R 4.4.1)
cowplot 1.1.3 CRAN (R 4.4.1)
crayon 1.5.3 CRAN (R 4.4.2)
curl 6.2.1 CRAN (R 4.4.1)
data.table 1.17.0 CRAN (R 4.4.1)
devtools 2.4.5 CRAN (R 4.4.1)
DiagrammeR 1.0.11 CRAN (R 4.4.1)
DiagrammeRsvg 0.1 CRAN (R 4.4.1)
digest 0.6.37 CRAN (R 4.4.0)
doFuture 1.0.1 CRAN (R 4.4.1)
doParallel 1.0.17 CRAN (R 4.4.1)
dplyr 1.1.4 CRAN (R 4.4.1)
ellipsis 0.3.2 CRAN (R 4.4.1)
emmeans 1.10.7 CRAN (R 4.4.1)
estimability 1.5.1 CRAN (R 4.4.1)
evaluate 1.0.3 CRAN (R 4.4.1)
expsmooth 2.3 CRAN (R 4.4.1)
factoextra 1.0.7 CRAN (R 4.4.1)
farver 2.1.2 CRAN (R 4.4.1)
fastcluster 1.2.6 CRAN (R 4.4.1)
fastmap 1.2.0 CRAN (R 4.4.1)
fma 2.5 CRAN (R 4.4.1)
forcats 1.0.0 CRAN (R 4.4.1)
foreach 1.5.2 CRAN (R 4.4.1)
forecast 8.23.0 CRAN (R 4.4.1)
Formula 1.2-5 CRAN (R 4.4.1)
fpp2 2.5 CRAN (R 4.4.1)
fracdiff 1.5-3 CRAN (R 4.4.1)
fs 1.6.5 CRAN (R 4.4.2)
future 1.34.0 CRAN (R 4.4.1)
future.apply 1.11.3 CRAN (R 4.4.1)
generics 0.1.3 CRAN (R 4.4.1)
ggh4x 0.3.0 CRAN (R 4.4.1)
ggplot2 3.5.1 CRAN (R 4.4.1)
ggpubr 0.6.0 CRAN (R 4.4.1)
ggrepel 0.9.6 CRAN (R 4.4.1)
ggseqplot 0.8.5 CRAN (R 4.4.1)
ggsignif 0.6.4 CRAN (R 4.4.1)
globals 0.16.3 CRAN (R 4.4.1)
glue 1.8.0 CRAN (R 4.4.2)
gridExtra 2.3 CRAN (R 4.4.1)
gtable 0.3.6 CRAN (R 4.4.1)
gtsummary 2.1.0 CRAN (R 4.4.1)
haven 2.5.4 CRAN (R 4.4.1)
hms 1.1.3 CRAN (R 4.4.1)
htmltools 0.5.8.1 CRAN (R 4.4.1)
htmlwidgets 1.6.4 CRAN (R 4.4.1)
httpuv 1.6.15 CRAN (R 4.4.1)
iterators 1.0.14 CRAN (R 4.4.1)
job 0.3.1 CRAN (R 4.4.1)
jsonlite 1.9.1 CRAN (R 4.4.1)
kableExtra 1.4.0 CRAN (R 4.4.1)
km.ci 0.5-6 CRAN (R 4.4.2)
KMsurv 0.1-5 CRAN (R 4.4.0)
knitr 1.49 CRAN (R 4.4.2)
labeling 0.4.3 CRAN (R 4.4.1)
later 1.4.1 CRAN (R 4.4.2)
lattice 0.22-6 CRAN (R 4.4.1)
lifecycle 1.0.4 CRAN (R 4.4.1)
listenv 0.9.1 CRAN (R 4.4.1)
lmtest 0.9-40 CRAN (R 4.4.1)
lubridate 1.9.4 CRAN (R 4.4.1)
magrittr 2.0.3 CRAN (R 4.4.1)
MASS 7.3-60.2 CRAN (R 4.4.1)
Matrix 1.7-0 CRAN (R 4.4.1)
memoise 2.0.1 CRAN (R 4.4.1)
mgcv 1.9-1 CRAN (R 4.4.1)
mime 0.12 CRAN (R 4.4.1)
miniUI 0.1.1.1 CRAN (R 4.4.1)
mnormt 2.1.1 CRAN (R 4.4.1)
multcomp 1.4-28 CRAN (R 4.4.1)
munsell 0.5.1 CRAN (R 4.4.1)
mvtnorm 1.3-3 CRAN (R 4.4.1)
NbClust 3.0.1 CRAN (R 4.4.1)
nlme 3.1-164 CRAN (R 4.4.1)
nnet 7.3-19 CRAN (R 4.4.1)
pacman 0.5.1 CRAN (R 4.4.1)
parallelly 1.42.0 CRAN (R 4.4.1)
patchwork 1.3.0 CRAN (R 4.4.1)
permute 0.9-7 CRAN (R 4.4.1)
pillar 1.10.1 CRAN (R 4.4.1)
pkgbuild 1.4.6 CRAN (R 4.4.1)
pkgconfig 2.0.3 CRAN (R 4.4.1)
pkgload 1.4.0 CRAN (R 4.4.2)
png 0.1-8 CRAN (R 4.4.0)
profvis 0.4.0 CRAN (R 4.4.2)
progressr 0.15.1 CRAN (R 4.4.1)
promises 1.3.2 CRAN (R 4.4.2)
psych 2.4.12 CRAN (R 4.4.1)
purrr 1.0.4 CRAN (R 4.4.1)
quadprog 1.5-8 CRAN (R 4.4.0)
quantmod 0.4.26 CRAN (R 4.4.1)
R.methodsS3 1.8.2 CRAN (R 4.4.1)
R.oo 1.27.0 CRAN (R 4.4.1)
R.utils 2.13.0 CRAN (R 4.4.1)
R6 2.6.1 CRAN (R 4.4.1)
ragg 1.3.3 CRAN (R 4.4.2)
rbibutils 2.3 CRAN (R 4.4.1)
RColorBrewer 1.1-3 CRAN (R 4.4.1)
Rcpp 1.0.14 CRAN (R 4.4.1)
Rdpack 2.6.2 CRAN (R 4.4.1)
readr 2.1.5 CRAN (R 4.4.1)
remotes 2.5.0 CRAN (R 4.4.1)
rio 1.2.3 CRAN (R 4.4.1)
rlang 1.1.5 CRAN (R 4.4.1)
rmarkdown 2.29 CRAN (R 4.4.2)
rstatix 0.7.2 CRAN (R 4.4.1)
rstudioapi 0.17.1 CRAN (R 4.4.2)
rsvg 2.6.1 CRAN (R 4.4.1)
sandwich 3.1-1 CRAN (R 4.4.1)
scales 1.3.0 CRAN (R 4.4.1)
sessioninfo 1.2.3 CRAN (R 4.4.1)
shiny 1.10.0 CRAN (R 4.4.1)
stargazer 5.2.3 CRAN (R 4.4.0)
stringi 1.8.4 CRAN (R 4.4.1)
stringr 1.5.1 CRAN (R 4.4.1)
survival 3.6-4 CRAN (R 4.4.1)
survminer 0.5.0 CRAN (R 4.4.2)
survMisc 0.5.6 CRAN (R 4.4.2)
svglite 2.1.3 CRAN (R 4.4.1)
systemfonts 1.2.1 CRAN (R 4.4.1)
textshaping 1.0.0 CRAN (R 4.4.1)
TH.data 1.1-3 CRAN (R 4.4.1)
tibble 3.2.1 CRAN (R 4.4.1)
tidyr 1.3.1 CRAN (R 4.4.1)
tidyselect 1.2.1 CRAN (R 4.4.1)
tidyverse 2.0.0 CRAN (R 4.4.3)
timechange 0.3.0 CRAN (R 4.4.1)
timeDate 4041.110 CRAN (R 4.4.1)
Tmisc 1.0.1 CRAN (R 4.4.1)
TraMineR 2.2-11 CRAN (R 4.4.1)
TraMineRextras 0.6.8 CRAN (R 4.4.1)
tseries 0.10-58 CRAN (R 4.4.1)
TTR 0.24.4 CRAN (R 4.4.1)
tzdb 0.4.0 CRAN (R 4.4.1)
urca 1.3-4 CRAN (R 4.4.1)
urlchecker 1.0.1 CRAN (R 4.4.1)
usethis 3.1.0 CRAN (R 4.4.2)
utf8 1.2.4 CRAN (R 4.4.1)
V8 6.0.1 CRAN (R 4.4.1)
vctrs 0.6.5 CRAN (R 4.4.1)
vegan 2.6-10 CRAN (R 4.4.1)
vegclust 2.0.2 CRAN (R 4.4.1)
viridisLite 0.4.2 CRAN (R 4.4.1)
visNetwork 2.1.2 CRAN (R 4.4.1)
WeightedCluster 1.8-1 CRAN (R 4.4.1)
withr 3.0.2 CRAN (R 4.4.2)
writexl 1.5.1 CRAN (R 4.4.1)
xfun 0.51 CRAN (R 4.4.1)
xml2 1.3.7 CRAN (R 4.4.1)
xtable 1.8-4 CRAN (R 4.4.1)
xts 0.14.1 CRAN (R 4.4.1)
yaml 2.3.10 CRAN (R 4.4.1)
zoo 1.8-13 CRAN (R 4.4.1)

Tiempo que demora esta sección: 0 minutos

Código
reticulate::py_list_packages()|> 
 knitr::kable(caption = "Python packages", format = "html",
      col.names = c("Package", "Version", "Requirement"),
    row.names = FALSE,
      align = c("c", "l", "r", "r"))|> 
  kableExtra::kable_styling(bootstrap_options = c("striped", "hover"),font_size = 12) |> 
  kableExtra::scroll_box(width = "100%", height = "375px")  
Python packages
Package Version Requirement
absl-py 2.1.0 absl-py==2.1.0
asttokens 2.4.1 asttokens==2.4.1
astunparse 1.6.3 astunparse==1.6.3
audioconverter 2.0.3 audioconverter==2.0.3
autograd 1.6.2 autograd==1.6.2
autograd-gamma 0.5.0 autograd-gamma==0.5.0
beautifulsoup4 4.12.3 beautifulsoup4==4.12.3
Brotli 1.1.0 Brotli==1.1.0
certifi 2023.11.17 certifi==2023.11.17
cffi 1.16.0 cffi==1.16.0
charset-normalizer 3.3.2 charset-normalizer==3.3.2
clarabel 0.9.0 clarabel==0.9.0
click 8.1.7 click==8.1.7
cloudpickle 3.0.0 cloudpickle==3.0.0
colorama 0.4.6 colorama==0.4.6
comm 0.2.1 comm==0.2.1
contourpy 1.2.0 contourpy==1.2.0
cvxopt 1.3.2 cvxopt==1.3.2
cvxpy 1.5.2 cvxpy==1.5.2
cycler 0.12.1 cycler==0.12.1
debugpy 1.8.0 debugpy==1.8.0
decorator 4.4.2 decorator==4.4.2
delete-chrome-history-py 0.1.8 delete-chrome-history-py==0.1.8
easyocr 1.7.1 easyocr==1.7.1
ecos 2.0.13 ecos==2.0.13
editdistance 0.8.1 editdistance==0.8.1
efficientnet 1.0.0 efficientnet==1.0.0
essential-generators 1.0 essential-generators==1.0
et-xmlfile 1.1.0 et-xmlfile==1.1.0
executing 2.0.1 executing==2.0.1
fancyimpute 0.7.0 fancyimpute==0.7.0
ffmpeg 1.4 ffmpeg==1.4
ffmpeg-python 0.2.0 ffmpeg-python==0.2.0
filedir 0.0.3 filedir==0.0.3
filelock 3.13.1 filelock==3.13.1
flatbuffers 24.3.25 flatbuffers==24.3.25
fonttools 4.47.2 fonttools==4.47.2
formulaic 1.0.1 formulaic==1.0.1
fsspec 2023.12.2 fsspec==2023.12.2
future 0.18.3 future==0.18.3
gast 0.6.0 gast==0.6.0
git-filter-repo 2.45.0 git-filter-repo==2.45.0
google-pasta 0.2.0 google-pasta==0.2.0
graphviz 0.20.3 graphviz==0.20.3
grpcio 1.65.4 grpcio==1.65.4
gTTS 2.5.1 gTTS==2.5.1
h5py 3.11.0 h5py==3.11.0
idna 3.6 idna==3.6
imageio 2.34.2 imageio==2.34.2
imageio-ffmpeg 0.5.1 imageio-ffmpeg==0.5.1
imgaug 0.4.0 imgaug==0.4.0
iniconfig 2.0.0 iniconfig==2.0.0
interface-meta 1.3.0 interface-meta==1.3.0
ipykernel 6.29.5 ipykernel==6.29.5
ipython 8.20.0 ipython==8.20.0
jedi 0.19.1 jedi==0.19.1
Jinja2 3.1.3 Jinja2==3.1.3
joblib 1.4.0 joblib==1.4.0
jupyter_client 8.6.0 jupyter_client==8.6.0
jupyter_core 5.7.1 jupyter_core==5.7.1
keras 3.4.1 keras==3.4.1
Keras-Applications 1.0.8 Keras-Applications==1.0.8
keras-ocr 0.9.3 keras-ocr==0.9.3
kiwisolver 1.4.5 kiwisolver==1.4.5
knnimpute 0.1.0 knnimpute==0.1.0
lazy_loader 0.4 lazy_loader==0.4
libclang 18.1.1 libclang==18.1.1
lifelines 0.28.0 lifelines==0.28.0
llvmlite 0.41.1 llvmlite==0.41.1
Markdown 3.6 Markdown==3.6
markdown-it-py 3.0.0 markdown-it-py==3.0.0
MarkupSafe 2.1.4 MarkupSafe==2.1.4
matplotlib 3.8.2 matplotlib==3.8.2
matplotlib-inline 0.1.6 matplotlib-inline==0.1.6
mdurl 0.1.2 mdurl==0.1.2
mido 1.3.3 mido==1.3.3
ml-dtypes 0.4.0 ml-dtypes==0.4.0
more-itertools 10.2.0 more-itertools==10.2.0
moviepy 1.0.3 moviepy==1.0.3
mpmath 1.3.0 mpmath==1.3.0
multipledispatch 1.0.0 multipledispatch==1.0.0
mutagen 1.47.0 mutagen==1.47.0
namex 0.0.8 namex==0.0.8
natsort 8.4.0 natsort==8.4.0
nest-asyncio 1.5.9 nest-asyncio==1.5.9
networkx 3.2.1 networkx==3.2.1
ninja 1.11.1.1 ninja==1.11.1.1
nose 1.3.7 nose==1.3.7
numba 0.58.1 numba==0.58.1
numexpr 2.10.0 numexpr==2.10.0
numpy 1.26.3 numpy==1.26.3
openai-whisper 20231117 openai-whisper==20231117
opencv-python 4.10.0.84 opencv-python==4.10.0.84
opencv-python-headless 4.10.0.84 opencv-python-headless==4.10.0.84
openpyxl 3.1.4 openpyxl==3.1.4
opt-einsum 3.3.0 opt-einsum==3.3.0
optree 0.12.1 optree==0.12.1
osqp 0.6.5 osqp==0.6.5
packaging 23.2 packaging==23.2
pandas 2.2.0 pandas==2.2.0
pandas-flavor 0.6.0 pandas-flavor==0.6.0
parso 0.8.3 parso==0.8.3
patsy 0.5.6 patsy==0.5.6
pillow 10.2.0 pillow==10.2.0
platformdirs 4.1.0 platformdirs==4.1.0
pluggy 1.5.0 pluggy==1.5.0
polars 1.9.0 polars==1.9.0
proglog 0.1.10 proglog==0.1.10
prompt-toolkit 3.0.43 prompt-toolkit==3.0.43
protobuf 4.25.4 protobuf==4.25.4
psutil 5.9.8 psutil==5.9.8
pure-eval 0.2.2 pure-eval==0.2.2
pyarrow 15.0.0 pyarrow==15.0.0
pyclipper 1.3.0.post5 pyclipper==1.3.0.post5
pycparser 2.22 pycparser==2.22
pycryptodomex 3.20.0 pycryptodomex==3.20.0
pydotplus 2.0.2 pydotplus==2.0.2
pydub 0.24.1 pydub==0.24.1
Pygments 2.17.2 Pygments==2.17.2
pyjanitor 0.26.0 pyjanitor==0.26.0
PyMuPDF 1.24.9 PyMuPDF==1.24.9
PyMuPDFb 1.24.9 PyMuPDFb==1.24.9
pyparsing 3.1.1 pyparsing==3.1.1
PyPDF2 3.0.1 PyPDF2==3.0.1
pyreadr 0.5.0 pyreadr==0.5.0
pytesseract 0.3.10 pytesseract==0.3.10
pytest 8.3.1 pytest==8.3.1
python-bidi 0.6.0 python-bidi==0.6.0
python-dateutil 2.8.2 python-dateutil==2.8.2
pytube 15.0.0 pytube==15.0.0
pytube3 9.6.4 pytube3==9.6.4
pytz 2023.3.post1 pytz==2023.3.post1
pywin32 306 pywin32==306
PyYAML 6.0.1 PyYAML==6.0.1
pyzmq 25.1.2 pyzmq==25.1.2
qdldl 0.1.7.post1 qdldl==0.1.7.post1
regex 2023.12.25 regex==2023.12.25
requests 2.32.3 requests==2.32.3
rich 13.7.1 rich==13.7.1
rpy2 3.5.16 rpy2==3.5.16
scikit-image 0.24.0 scikit-image==0.24.0
scikit-learn 1.3.2 scikit-learn==1.3.2
scikit-survival 0.22.2 scikit-survival==0.22.2
scipy 1.11.4 scipy==1.11.4
scs 3.2.6 scs==3.2.6
seaborn 0.13.2 seaborn==0.13.2
semantic-version 2.10.0 semantic-version==2.10.0
setuptools-rust 1.8.1 setuptools-rust==1.8.1
shapely 2.0.5 shapely==2.0.5
six 1.16.0 six==1.16.0
soupsieve 2.5 soupsieve==2.5
SpeechRecognition 3.10.1 SpeechRecognition==3.10.1
spyder-kernels 2.5.2 spyder-kernels==2.5.2
stack-data 0.6.3 stack-data==0.6.3
statsmodels 0.14.1 statsmodels==0.14.1
sympy 1.12 sympy==1.12
target 0.0.11 target==0.0.11
tensorboard 2.17.0 tensorboard==2.17.0
tensorboard-data-server 0.7.2 tensorboard-data-server==0.7.2
tensorflow 2.17.0 tensorflow==2.17.0
tensorflow-intel 2.17.0 tensorflow-intel==2.17.0
tensorflow-io-gcs-filesystem 0.31.0 tensorflow-io-gcs-filesystem==0.31.0
termcolor 2.4.0 termcolor==2.4.0
threadpoolctl 3.4.0 threadpoolctl==3.4.0
tifffile 2024.7.24 tifffile==2024.7.24
tiktoken 0.5.2 tiktoken==0.5.2
torch 2.4.0 torch==2.4.0
torchaudio 2.4.0 torchaudio==2.4.0
torchvision 0.19.0 torchvision==0.19.0
tornado 6.4 tornado==6.4
tqdm 4.66.1 tqdm==4.66.1
traitlets 5.14.1 traitlets==5.14.1
translator 0.0.9 translator==0.0.9
typing_extensions 4.9.0 typing_extensions==4.9.0
tzdata 2023.4 tzdata==2023.4
tzlocal 5.2 tzlocal==5.2
urllib3 2.1.0 urllib3==2.1.0
validators 0.33.0 validators==0.33.0
watchdog 3.0.0 watchdog==3.0.0
wcwidth 0.2.13 wcwidth==0.2.13
websockets 12.0 websockets==12.0
Werkzeug 3.0.3 Werkzeug==3.0.3
whisper 1.1.10 whisper==1.1.10
wrapt 1.16.0 wrapt==1.16.0
xarray 2024.1.1 xarray==2024.1.1
youtube-dl 2021.12.17 youtube-dl==2021.12.17
yt-dlp 2024.7.9 yt-dlp==2024.7.9

Tiempo que demora esta sección: 0 minutos